I want to loop through every row and do some actions for multiple cells selected, e.g. K3,N3,Q3,T3,W3,Z3 next K4,N4,Q4... etc.
What am I doing wrong?
Sub Colors_test()
For counter = 3 To 110
Range("K" & counter, "N" & counter, "Q" & counter, "T" & _
counter, "W" & counter, "Z" & counter).Select
Selection.FormatConditions.AddColorScale ColorScaleType:=3
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.Color = 7039480
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValuePercentile
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = 8711167
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
xlConditionValueHighestValue
With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
.Color = 8109667
.TintAndShade = 0
End With
Next counter
MsgBox "Ok All " & counter
End Sub
There is no need to loop. You can use the below code.
Sub Colors_test()
With Range("K3:K110,N3:N110,Q3:Q110,T3:T110,W3:W110,Z3:Z110")
.Select
// your code here
End With
End Sub
You need to pass in the range as 1 argument. Try this:
Range("K" & counter & ",N" & counter & ",Q" & counter & ",T" & counter & ",W" & counter & ",Z" & counter).Select
Related
I have been developing various reports and forms for data we are currently pulling from a legacy system. I have created a form that dynamically creates buttons and spaces them according to how many buttons have been created. My error comes in where I attempt to add _Click() functionality for each button, as the code will be unique for each button created. I have tried everything I can come up with and everything I have been able to find online, all to no avail. Through various different attempts, I have gotten to points where I have the buttons and the code populated in the UserForm CodeModule, but the _Click() event would not trigger from there. Any help would be greatly appreciated.
Private Sub CommandButton5_Click()
Dim lastrow As Long, i As Integer, numButtons As Integer, newButton As Control, lineNum As Long
numButtons = 1
With Sheets("Production Capacity")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A4:AD" & lastrow).Interior.Color = RGB(255, 255, 255)
For i = 4 To lastrow
If i Mod 4 = 0 Then
If .Cells(i, "D").Value > .Cells(2, "G").Value Then
.Cells(i, "G").Interior.Color = RGB(255, 0, 0)
Set newButton = Me.Controls.Add("Forms.CommandButton.1", "button" & numButtons, False)
With newButton
.Width = 200
Select Case (numButtons Mod 3)
Case 0
.Left = 475
Case 1
.Left = 25
Case 2
.Left = 250
End Select
.Visible = True
.Height = 20
.Top = 60 + (Int((numButtons - 1) / 3) * 40)
.Caption = Sheets("Production Capacity").Cells(i, "A").Value & " - " & Sheets("Production Capacity").Cells(i, "B").Value & " DeptName"
.Font.Size = 10
.Font.Bold = True
End With
With ActiveWorkbook.VBProject.VBComponents("Class1").CodeModule
lineNum = .CreateEventProc("Click", "button" & numButtons) + 1 'This line is where the error occurs.
.InsertLines lineNum, _
"Dim lastrow as Long" & Chr(13) & _
"with Sheets(Sheets(""Production Capacity"").cells(1, ""A"").value)" & Chr(13) & _
".ShowAllData" & Chr(13) & _
"lastrow = .Cells(Rows.Count, ""B"").End(xlUp).Row" & Chr(13) & _
".Range(""A$6:$BQ$"" & lastrow).AutoFilter field:=30, Criteria1:=" & Chr(34) & ">=" & Chr(34) & " & " & Chr(34) & DateValue(Sheets("Production Capacity").Cells(i, "A").Value) & Chr(34) & ", Operator:=xlAnd, Criteria2:=" & Chr(34) & "<=" & Chr(34) & " & " & Chr(34) & DateValue(Sheets("Production Capacity").Cells(i, "B").Value) & Chr(34) & ", Operator:=xlAnd" & Chr(13) & _
"End With"
End With
numButtons = numButtons + 1
End If
The error is 'Run-time error '57017':
Event handler is invalid
on this line: lineNum = .CreateEventProc("Click", "button" & numButtons) + 1
Credit to #DisplayName! Thank you so much for helping me to simplify my solution and stop over-engineering it. My new Sub for the UserForm is as below:
Dim mColButtons As New Collection
Private Sub CommandButton5_Click()
Dim lastrow As Long, i As Integer, numButtons As Integer
Dim btnEvent As Class1
Dim ctl As MSForms.Control
numButtons = 1
With Sheets("Production Capacity")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A4:AD" & lastrow).Interior.Color = RGB(255, 255, 255)
For i = 4 To lastrow
If i Mod 4 = 0 Then
If .Cells(i, "D").Value > .Cells(2, "G").Value Then
.Cells(i, "G").Interior.Color = RGB(255, 0, 0)
Set ctl = Me.Controls.Add("Forms.CommandButton.1")
With ctl
.Width = 200
Select Case (numButtons Mod 3)
Case 0
.Left = 475
Case 1
.Left = 25
Case 2
.Left = 250
End Select
.Visible = True
.Height = 20
.Top = 60 + (Int((numButtons - 1) / 3) * 40)
.Caption = Sheets("Production Capacity").Cells(i, "A").Value & " - " & Sheets("Production Capacity").Cells(i, "B").Value & " DeptName"
.Font.Size = 10
.Font.Bold = True
.Name = "button" & numButtons
End With
Set btnEvent = New Class1
Set btnEvent.btn = ctl
Set btnEvent.frm = Me
mColButtons.Add btnEvent
numButtons = numButtons + 1
End If
My Class Module now looks like this, and it simplifies all of the logic into a concise Select statement. Thank you again.
Public WithEvents btn As MSForms.CommandButton
Public frm As UserForm
Private Sub btn_click()
Dim startDate As String, endDate As String, department As String, lastrow As Long
startDate = Split(btn.Caption, " ")(0)
endDate = Split(btn.Caption, " ")(2)
department = Split(btn.Caption, " ")(3)
With Sheets(Sheets("Production Capacity").Cells(1, "A").Value)
lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
Select Case department
Case "Veneering"
.ShowAllData
.Range("A$6:$BQ$" & lastrow).AutoFilter field:=21, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
Case "MillMachining"
.ShowAllData
.Range("A$6:$BQ$" & lastrow).AutoFilter field:=30, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
Case "BoxLine"
.ShowAllData
.Range("A$6:$BQ$" & lastrow).AutoFilter field:=39, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
Case "Custom"
.ShowAllData
.Range("A$6:$BQ$" & lastrow).AutoFilter field:=48, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
Case "Finishing"
.ShowAllData
.Range("A$6:$BQ$" & lastrow).AutoFilter field:=57, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
End Select
End With
End Sub
I'm using this bit of VBA code to detect hidden rows on a spreadsheet. On top of this, I want it to unhide those rows and highlight the cells in the previously hidden row from columns A to W with a red border.
Sub ShowRows()
Dim rng As Range
Dim r As Range
Dim sTemp As String
Set rng = Range("A1:A1000")
sTemp = ""
For Each r In rng.Rows
If r.EntireRow.Hidden Then
sTemp = sTemp & "Row " & Mid(r.Address, 4) & vbCrLf
End If
Next r
If sTemp > "" Then
sTemp = "The following rows are hidden:" & vbCrLf & _
vbCrLf & sTemp
MsgBox sTemp
Else
MsgBox "There are no hidden rows."
End If
End Sub
Edit: Sorry. I forgot to mention that a later part of this script applies some conditional formatting to all rows. Whether this part of this script comes before or after that, I suppose it doesn't matter. But I don't want this to take the place of other formatting, just add to it by applying a border.
Something like this?:
Sub ShowRows()
Dim rng As Range
Dim r As Range
Dim sTemp As String
Set rng = Range("A1:A1000")
sTemp = ""
For Each r In rng.Rows
If r.EntireRow.Hidden = True Then
sTemp = sTemp & "Row " & Mid(r.Address, 4) & vbCrLf
r.EntireRow.Hidden = false
With Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeLeft)
.Color = -16776961
.Weight = xlMedium
End With
With Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeTop)
.Color = -16776961
.Weight = xlMedium
End With
With Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeBottom)
.Color = -16776961
.Weight = xlMedium
End With
With Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeRight)
.Color = -16776961
.Weight = xlMedium
End With
End If
Next r
If sTemp <> "" Then
sTemp = "The following rows are hidden:" & vbCrLf & _
vbCrLf & sTemp
MsgBox sTemp
Else
MsgBox "There are no hidden rows."
End If
End Sub
Just add lines to unhide and colour the rows in your rows loop
Sub ShowRows()
Dim rng As Range
Dim r As Range
Dim sTemp As String
Dim sTemp2 As String
Set rng = Range("A1:A1000")
sTemp = ""
For Each r In rng.Rows
If r.EntireRow.Hidden Then
sTemp = sTemp & "Row " & Mid(r.Address, 4) & vbCrLf
r.Hidden = False
sTemp2 = "A" & Mid(r.Address, 4) & ":H" & Mid(r.Address, 4)
Range(sTemp2).Borders.Color = vbRed
End If
Next r
If sTemp > "" Then
sTemp = "The following rows are hidden:" & vbCrLf & _
vbCrLf & sTemp
MsgBox sTemp
Else
MsgBox "There are no hidden rows."
End If
End Sub
I am trying to move some of my conditional formatting to VBA but apply it to ranges that may change every time I run the macro. I think I have defined my ranges, variables, formulas and formats correctly (never done vba format.conditions so syntax could be wrong there). When I run the code it stops on the line
With checkrange.FormatConditions _
.Add(xlCellValue, xlGreater, Formula1:="=R" & cfcll.Row & "C" & q & "+ " & devone & ")")
with run-time error 5, invalid procedure or call.
The full section of code is as follows:
Dim cflastrow As Long
Dim cfrange As Range
Dim cfcll As Range
Dim checkrange As Range
Dim q As Long
Dim devone As Long
Dim devtwo As Long
Dim devthree As Long
Dim devfour As Long
cflastrow = finwb.Sheets("strt_Dash_Final").Cells(Rows.Count, 52).End(xlUp).Row
Set cfrange = finwb.Sheets("Strt_Dash_Final").Range("AV6:AV" & cflastrow)
For Each cfcll In cfrange
If cfcll.value <> "" Then
For q = 4 To 38
Set checkrange = finwb.Sheets("Strt_Dash_Final").Range(Cells((cfcll.Row + 1), q), Cells((cfcll.Row + (cfcll.value - 2)), q))
devone = Application.WorksheetFunction.StDev_P(checkrange)
With checkrange.FormatConditions _
.Add(xlCellValue, xlGreater, Formula1:="=R" & cfcll.Row & "C" & q & "+ " & devone & ")")
With .Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
End With
End With
With checkrange.FormatConditions _
.Add(xlCellValue, xlGreater, "=" & Cells(cfcll.Row, q).value & "+ 2*stddev(" & checkrange & ")")
With .Font
.Color = 255
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
End With
End With
With checkrange.FormatConditions _
.Add(xlCellValue, xlGreater, "=" & Cells(cfcll.Row, q).value & "- stddev(" & checkrange & ")")
With .Font
.ThemeColor = xlThemeColorAccent3
.TintAndShade = -0.499984741
.ThemeFont = xlThemeFontMinor
End With
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
End With
End With
With checkrange.FormatConditions _
.Add(xlCellValue, xlGreater, "=" & Cells(cfcll.Row, q).value & "- 2*stddev(" & checkrange & ")")
With .Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
End With
End With
Next q
ElseIf cfcll.value = "" Then
'nada
End If
Next cfcll
Also, despite the range 'checkrange' definitely being correct (checked buy using checkrange = 5 and all values went to 5) devone always comes out as '1' when it should be something like 1.23.....
My theory is that I may not be using R1C1 correctly in the formula context but I saw it used this way in a couple of other examples so am now really not sure. Any help, as always, is greatly appreciated!
In
With checkrange.FormatConditions _
.Add(xlCellValue, xlGreater, Formula1:="=R" & cfcll.Row & "C" & q & "+ " & devone & ")")
the formula will be =R5C4+ 1) if cfcll.Row is 5 and q is 4 and devone is 1.
As you see there is a closing parenthesis to much.
With checkrange.FormatConditions _
.Add(xlCellValue, xlGreater, Formula1:="=R" & cfcll.Row & "C" & q & "+ " & devone)
How to debug? Put the formula in a string variable first
sFormula = "=R" & cfcll.Row & "C" & q & "+ " & devone & ")"
then you would have seen this.
For users having non English Excel versions:
The formulas set for FormatConditions with VBA must be in the language of the Excel. They must not be in US-English as usual in VBA. So R1C1 will be Z1S1 in German Excel for example. Thats weird and annoying.
And to your devone: It is Dimed as Long which is a integer type. So not a wonder that it does not contains Double values.
I am trying to open multiple excel worksheets for one workbook. I have following code but it generates error on Sheets("sheet3").select line.
I don't know why?
Set xlSheet = xlBook.Worksheets(3)
With xlSheet
.Name = "sheet3"
....
....
....
i = 6
Do While Not rsl.EOF
.Range("A" & i).Value = Nz(rsl!x, "")
.Range("B" & i).Value = Nz(rsl!y, "")
.Range("C" & i).Value = Nz(rsl!z, "")
.Range("D" & i).Value = Nz(rsl!xx, "")
.Range("E" & i).Value = Nz(rsl!yy, "")
.Range("F" & i).Value = Nz(rsl!zz, "")
.Range("G" & i).Value = Nz(rsl!xxx, "")
.Range("H" & i).Value = Nz(rsl!yyy, "")
.Range("I" & i).Value = Nz(rsl!zzz, "")
i = i + 1
rsl.MoveNext
Loop
End With
With xlSheet
Set rng = .Range("A6:I5000")
Sheets("sheet3").Select
rng.FormatConditions.Add Type:=xlExpression, Formula1:=""
rng.FormatConditions(rng.FormatConditions.Count).SetFirstPriority
With rng.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = ANy Color
End With
Set rng = .Range("A6:I5000")
Sheets("sheet3").Select
rng.FormatConditions.Add Type:=xlExpression, Formula1:=""
rng.FormatConditions(rng.FormatConditions.Count).SetFirstPriority
With rng.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = Any color
.TintAndShade = 0
End With
End With
Do I need to replace Sheets("").Select with something else? Or how do I achieve it?
Thanks,
I've got a routine that loops through all columns on all worksheets in a workbook to apply a conditional formatting rule to all of them. The rule is saved on each column fine and the rule I've used works, but the colour doesn't change after the routine is run. I can then go into the worksheet, select conditional formatting, click 'edit rule' > 'ok' > 'ok' and the formatting then updates on the worksheet, without having to change anything about the rule. What am I missing to get the rule to actually make a change to the worksheet?
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "*Management*" Then Exit Sub
lastRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
lastCol = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
ws.Cells.FormatConditions.Delete
For col = 1 To lastCol
Set rng = ws.Range(ws.Cells(2, col), ws.Cells(lastRow, col))
formulaStr = "=BITWISE_AND(2^INDEX(" & wsSchema.Name & "!$" & schemaLastCol & "$2" & _
":$" & schemaLastCol & "$" & schemaLastRow & ", MATCH(1, (" & wsSchema.Name & "!$A$2:$A$" & _
schemaLastRow & "=""" & ws.Name & """)*(" & wsSchema.Name & "!$B$2:$B$" & schemaLastRow & "=$" & _
XLCol(col) & "$1),0)), INDEX($" & XLCol(lastCol) & "$1:$" & XLCol(lastCol) & "$" & lastRow & ",ROW()))"
With rng
.FormatConditions.Add xlExpression, , formulaStr & " = 0"
With .FormatConditions(1)
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = RGB(255, 0, 0)
.Interior.TintAndShade = 0
.StopIfTrue = False
.SetFirstPriority
End With
.FormatConditions.Add xlExpression, , formulaStr & " > 0"
With .FormatConditions(2)
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = RGB(0, 255, 0)
.Interior.TintAndShade = 0
.StopIfTrue = False
.SetFirstPriority
End With
End With
Next
Next
Try ThisWorkbook.RefreshAll or Application.Calculate