I have a macro in my workbook that is tied to a hotkey which highlights all columns in the currently selected row. However, it only works if one row is selected. I cant think of a way to adjust it to highlight all the rows if multiple are selected. Here is the code that I am currently using.
Sub highlight_done()
'
' highlight_done Macro
'
' Keyboard Shortcut: Ctrl+q
'
Dim r As Long
r = ActiveCell.Row
Range("A" & r & ":Y" & r).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Color = vbWhite
.TintAndShade = 0
End With
End Sub
Any help would be appreciated.
Perhaps like the following, using Intersect and Selection.EntireRow to get the range to be colored:
Sub highlight_done()
'
' highlight_done Macro
'
' Keyboard Shortcut: Ctrl+q
'
If Not TypeOf Selection Is Range Then Exit Sub
Dim rng As Range
Set rng = Intersect(Selection.EntireRow, Range("A:Y"))
With rng.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With rng.Font
.Color = vbWhite
.TintAndShade = 0
End With
End Sub
Related
In my worksheet, I have a table with buttons to add or erase a line below the last filled line. (It copies a range of pre-filled data and formatting from another sheet, or erases it - I don't delete the row in case it would mess with my other sheets).
When I copy the data it updates the table range, but when I erase it, it doesn't... so when I copy a new one, it skips a line.
This is the delete sub:
Sub DeleteLastLine()
'
' DeleteLastLine Macro
'
'
Sheets("Cadastro Geral").Select
Range("A" & Rows.Count).End(xlUp).EntireRow.Select 'I WOULD HAVE TO EITHER FIND A WAY TO SELECT THE LAST CELL WITH CONTENT IGNORING THE TABLE RANGE'
Selection.ClearContents
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Dim tbl As ListObject
'OR FIND A WAY TO DYNAMICALLY RESIZE THE RANGE OF MY TABLE. NOW IT GOES FROM A3:AI913... TOMORROW IT MIGHT BE AT A3:AI950
Range("A" & Rows.Count).End(xlUp).Select
End Sub
In Excel, I wrote this code to run a particular routine each time the Print Button is pressed. It changes the sheet color to white and changes it back after printing.
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
Application.EnableEvents = False
' change color to white
Range("A6:BD53").Interior.ColorIndex = 0
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
' AfterPrint_ change color back
Range( _
"G6:BD6,G8:AD8,AI8:BD8,AN11:AO11,Y11:Z11,F11:V11,K13:AK13,Q14:AK14,J15:T15,P38:P39"). _
Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range( _
"AB15:AE15,AU14:AX14,AU15:AX15,AU16:AX16,AA17:AC17,N24:W24,E28:O32,R28:U28,X28:AB31,AV37:BD37,V40:AL40,P41:U42,V43:AL43,V45:AL45,AV43:BD44" _
).Select
Range("AV43").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Application.EnableEvents = True
End Sub
It works just fine if I print each sheet singularly, but doesn't if I try to print many sheets at once, i.e. if I select more sheets at one time and print them. In this case, the routine is run only for the first sheet being printed and not for the others. Anyone knows why and what I can do to correct it?
Try this use of a For loop to go through all the selected sheets:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
On Error GoTo Err
Application.EnableEvents = False
Dim ws As Worksheet
For Each ws In ActiveWindow.SelectedSheets
' change color to white
ws.Range("A6:BD53").Interior.ColorIndex = 0
ws.PrintOut Copies:=1, Collate:=True
' AfterPrint_ change color back
With ws.Range("G6:BD6,G8:AD8,AI8:BD8,AN11:AO11,Y11:Z11,F11:V11,K13:AK13,Q14:AK14,J15:T15,P38:P39").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With ws.Range("AV43").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next ws
Err:
Application.EnableEvents = True
End Sub
As you described in the comments you are experiencing some unusal printing behavior. You can use this less elegant version of the code above, this should circumvent your problem:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
On Error GoTo Err
Application.EnableEvents = False
Dim ws As Worksheet
For Each ws In ActiveWindow.SelectedSheets
' change color to white
ws.Range("A6:BD53").Interior.ColorIndex = 0
Next ws
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
For Each ws In ActiveWindow.SelectedSheets
' AfterPrint_ change color back
With ws.Range("G6:BD6,G8:AD8,AI8:BD8,AN11:AO11,Y11:Z11,F11:V11,K13:AK13,Q14:AK14,J15:T15,P38:P39").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With ws.Range("AV43").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next ws
Err:
Application.EnableEvents = True
End Sub
Below us the code that I want some clarification for:
'Auto format the cells when you change cell B39
If Not Intersect(Target, Range("B39")) Is Nothing Then
If InStr(1, Range("B39"), "ABC") > 0 Then
Range("B13:B18,B22,B23,B25").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(100, 250, 150)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B19:B21,B24,B26:B35").Select
With Selection.Interior
.Pattern = xlNone
.PatternTintAndShade = 0
End With
Else: Range("B13:B35").Select
With Selection.Interior
.Pattern = xlNone
.PatternTintAndShade = 0
End With
End If
End If
If Not Intersect(Target, Range("B57")) Is Nothing Then
If Range("B57") = "DEF" Then
Range("B13:B18,B22,B23,B25,B30,B35").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(100, 250, 150)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B19:B21,B24,B26,B27:B29,B31:B34").Select
With Selection.Interior
.Pattern = xlNone
.PatternTintAndShade = 0
End With
End If
End If
End Sub
In cell B39 and B57 I have drop down list of products produced by the company. The above code highlights the requirements to manufacture those products. When I select a SKU from B39 the code highlights the range specified. Same for B57. When I change B39 first and then change B57 the highlighted cells change, I dont want this to happen. I want the changes due to selecting a SKU from B39 to remain even after changing B57.
Hope this clarification is better.
Thank you!
Seems like the problem is that you have overlapping ranges you want to hilite/clear: you can't manage the highlighting like you're trying to when you have products with overlapping materials. What you'd need to do is clear all highlighting, then check each "target" cell to see what hilighting needs to be re-added: don't just check the one Target cell which was changed.
I moved the hiliting into a separate sub and removed any Select steps - these are typically best avoided.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("B39,B57")) Is Nothing Then
Hilite Range("B13:B100"), False '<< clear *all* hiliting
'add back any required hilites
If InStr(1, Range("B39"), "ABC") > 0 Then
Hilite Range("B13:B18,B22,B23,B25"), True
End If
If Range("B57") = "DEF" Then
Hilite Range("B13:B18,B22,B23,B25,B30,B35"), True
End If
End If
End Sub
'add/remove hilighting on a supplied range
Sub Hilite(rng As Range, hilight As Boolean)
With rng.Interior
If hilight Then
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(100, 250, 150)
.TintAndShade = 0
.PatternTintAndShade = 0
Else
.Pattern = xlNone
.PatternTintAndShade = 0
End If
End With
End Sub
I Set up a Macro that Finds the differences between the two rows and then highlights them. I want the macro to Cycle through the next two rows and do the same thing and go on until there are no more rows of data(This Number varies all the time). So the Next selection would be Rows 4:5 and it would Select the differences and highlight them and so on. How is this possible? Any help is greatly appreciated. Thank you,
FindVariance Macro
Rows("2:3").Select
Range("A3").Activate
Selection.ColumnDifferences(ActiveCell).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("F16").Select
End Sub
Try:
FindVariance Macro
For j=2 to Range("A1").End(xlDown).Row-1
i=j+1
Rows(j & ":" & i).ColumnDifferences(Range("A" & i)).Offset(1,0).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
j=j+1
Next j
End Sub
Here's my sample
Option Explicit
Sub FindVariance()
Dim last As Integer, i As Integer, r As Boolean
last = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For i = 2 To last
If i Mod 2 = 0 Then
Rows(i & ":" & i + 1).Select
r = Selection.ColumnDifferences(ActiveCell).Select
If r = True Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
Next i
Range("F16").Select
End Sub
it's always a good habit to:
use objects reference and avoid the use of selections
which can be deceiving and slows down the code
use full reference for ranges, up to the workbook.
to avoid point to an unwanted active sheet or workbook!
so here's my code
Sub FindVariance()
Dim j As Long
Dim nRows As Long
With ActiveSheet
nRows = .Cells(.Rows.Count, 1).End(xlUp).Row
For j = 2 To nRows Step 2
With .Rows(j).Resize(2).ColumnDifferences(.Cells(j + 1, 1)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next j
End With
End Sub
and there's still some job to do in order to catch and properly treat exceptions (uneven number of rows, empty rows...)
Hello again the last time I posted a question it was resolved quite quickly.
Essentially what I am trying to do is if a row in column r says Project Complete then I want it to grey out the row from column D:BM
I was playing around with a few things but it doesn’t want to work.
The column r is also a vlookup formula to another workbook, not sure if that makes a difference.
Dim rng As Range, cell As Range
Set rng = Range("R10:R1000")
For Each cell In rng
If cell.Value = "Project Complete" Then
Range("D" & ActiveCell.Row & ":BM" & ActiveCell.Row).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End If
Next cell
You can loop through the range without selection:
Sub OhYa()
Dim rng As Range, c As Range
Set rng = Range("R10:R1000")
For Each c In rng.Cells
If c = "Project Complete" Then
With Range("D" & c.Row & ":BM" & c.Row).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End If
Next c
End Sub