I want the run an IF/ELSE statement across the range of cells selected by the user.
Currently which ever IF/ELSE statement is true for the first cell in the selection, is then applying to all the cells in the section rather than doing a for each loop.
Sub MultiCellTest()
With Selection
If ActiveCell > 10 Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6684927
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16764159
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End With
End Sub
Thanks.
Here is how you would modify your code to handle each cell in the active selection.
Sub MultiCellTest()
For Each cell in Selection
If cell > 10 Then
With cell.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6684927
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
With cell.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16764159
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
End Sub
Related
Just wanted to know if the following code could be simplified without adding an array or a loop.
Variables Cell1, Cell2 & Cell3 are highly independent. That means they won't be the same every time, as they will come from several previous calculations.
With Rng
With .Columns(Cell1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Columns(Cell2).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Columns(Cell3).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
Is there a way to write something like:
With Rng
With .Columns(Cell1).Interior, .Columns(Cell2).Interior, .Columns(Cell3).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
Thanks,
You could use Union.
With Rng
With Union(.Columns(Cell1), .Columns(Cell2), .Columns(Cell3)).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
I'm trying to make a macro in VBA Excel to apply a few conditional formats.
See below:
Private Sub CommandButton1_Click()
'Delete conditional formats
Sheets("Results").Cells.FormatConditions.Delete
'Red formats
Sheets("Results").Select
With ActiveSheet.Range("C:C,A:A")
.FormatConditions.AddUniqueValues
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).DupeUnique = xlDuplicate
End With
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
'Blue formats
With ActiveSheet.Range("E:E,C:C,A:A")
.FormatConditions.AddUniqueValues
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).DupeUnique = xlUnique
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
The error pops up in these lines of code:
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Sometimes it works sometimes it doesn't.
I recorded this macro and was working fine few days ago.
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 was recently given the undertaking of expediting the speed of one of my company's large(ish) macros. I've done quite a decent job so far, as the last writer more or less used the record feature (making some of the code extraneous), which leads me to these formatting conditions:
With Range("AH10:AP10").Interior
.Pattern = xlSolid
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
With Range("AH17:AP17").Interior
.Pattern = xlSolid
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
With Range("AH24:AP24").Interior
.Pattern = xlSolid
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
With Range("AH34:AP34").Interior
.Pattern = xlSolid
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
With Range("AH42:AP42").Interior
.Pattern = xlSolid
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
My question then becomes, why does this not work in its place?
Dim RangeArr(5) As Variant
RangeArr(0) = Range("AH10:AP10")
RangeArr(1) = Range("AH17:AP17")
RangeArr(2) = Range("AH24:AP24")
RangeArr(3) = Range("AH34:AP34")
RangeArr(4) = Range("AH42:AP42")
For i = 0 To 4
With RangeArr(i).Interior
.Pattern = xlSolid
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
Next
I get a run-time error 424, object required for the loop, but using msgbox printing the array is valued as such. I'm assuming it's the array that's written incorrectly, I just can't find out how to fix it. Any suggestions are appreciated. Thanks!
You have made a good start! You need an array of ranges:
Sub human()
Dim RangeArr(0 To 4) As Range
Set RangeArr(0) = Range("AH10:AP10")
Set RangeArr(1) = Range("AH17:AP17")
Set RangeArr(2) = Range("AH24:AP24")
Set RangeArr(3) = Range("AH34:AP34")
Set RangeArr(4) = Range("AH42:AP42")
For I = 0 To 4
With RangeArr(I).Interior
.Pattern = xlSolid
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
Next
End Sub