Hello,
I'm trying to apply code currently being used for individual worksheets to the whole workbook. If the worksheet is not active and the below conditions are met, then I get a runtime error. Could you take a look at my code and see what I need to change and where I should put the code:
Private Sub Worksheet_Calculate()
Dim lLastRow As Long, Data1, ColE, ColG, ColH, COlI, lRow As Long
Dim shtThis As Worksheet, bThisRow As Boolean
Dim ranj As String
Data1 = Cells(1, 4).Value
Set shtThis = ActiveSheet
With Cells(5, 1).CurrentRegion
lLastRow = .Rows.Count + .Row - 1
End With
For lRow = 5 To lLastRow
ColE = Cells(lRow, 5).Value
ColF = Cells(lRow, 6).Value
ColG = Cells(lRow, 7).Value
ColH = Cells(lRow, .Value
COlI = Cells(lRow, 9).Value
bThisRow = False 'pay
cThisRow = False 'pay nothing
Select Case ColG
Case "DDD"
If ColH = Data1 Or COlI = Data1 Then _
cThisRow = True
Case "OO"
If ColE = Data1 Then _
bThisRow = True
Case "RRR"
Select Case ColF
Case "X"
If COlI = Data1 Then _
cThisRow = True
Case "O"
If ColH = Data1 Then _
cThisRow = True
End Select
Case "II"
Select Case ColF
Case "X"
If COlI = Data1 Then _
bThisRow = True
Case "O"
If ColH = Data1 Then _
bThisRow = True
End Select
Case "RKK"
Select Case ColF
Case "X"
If ColH = Data1 Then _
bThisRow = True
Case "O"
If COlI = Data1 Then _
bThisRow = True
End Select
Case "BOX"
Select Case ColF
Case "X"
If ColH = Data1 Then _
cThisRow = True
Case "O"
If COlI = Data1 Then _
cThisRow = True
End Select
End Select
With shtThis.Rows(lRow)
If bThisRow Then
'Cells(lRow, 12).Select
Range("A" & lRow & ":L" & lRow).Select
'ranj = "A" & lRow & ":L" & lRow
' Object.Range (ranj)
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
'Else
' With .Interior
' .ColorIndex = xlNone
' .Pattern = xlNone
' End With
End If
If cThisRow Then
Range("A" & lRow & ":L" & lRow).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If
End With
Next
End Sub
I'm trying to apply code currently being used for individual worksheets to the whole workbook. If the worksheet is not active and the below conditions are met, then I get a runtime error. Could you take a look at my code and see what I need to change and where I should put the code:
Private Sub Worksheet_Calculate()
Dim lLastRow As Long, Data1, ColE, ColG, ColH, COlI, lRow As Long
Dim shtThis As Worksheet, bThisRow As Boolean
Dim ranj As String
Data1 = Cells(1, 4).Value
Set shtThis = ActiveSheet
With Cells(5, 1).CurrentRegion
lLastRow = .Rows.Count + .Row - 1
End With
For lRow = 5 To lLastRow
ColE = Cells(lRow, 5).Value
ColF = Cells(lRow, 6).Value
ColG = Cells(lRow, 7).Value
ColH = Cells(lRow, .Value
COlI = Cells(lRow, 9).Value
bThisRow = False 'pay
cThisRow = False 'pay nothing
Select Case ColG
Case "DDD"
If ColH = Data1 Or COlI = Data1 Then _
cThisRow = True
Case "OO"
If ColE = Data1 Then _
bThisRow = True
Case "RRR"
Select Case ColF
Case "X"
If COlI = Data1 Then _
cThisRow = True
Case "O"
If ColH = Data1 Then _
cThisRow = True
End Select
Case "II"
Select Case ColF
Case "X"
If COlI = Data1 Then _
bThisRow = True
Case "O"
If ColH = Data1 Then _
bThisRow = True
End Select
Case "RKK"
Select Case ColF
Case "X"
If ColH = Data1 Then _
bThisRow = True
Case "O"
If COlI = Data1 Then _
bThisRow = True
End Select
Case "BOX"
Select Case ColF
Case "X"
If ColH = Data1 Then _
cThisRow = True
Case "O"
If COlI = Data1 Then _
cThisRow = True
End Select
End Select
With shtThis.Rows(lRow)
If bThisRow Then
'Cells(lRow, 12).Select
Range("A" & lRow & ":L" & lRow).Select
'ranj = "A" & lRow & ":L" & lRow
' Object.Range (ranj)
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
'Else
' With .Interior
' .ColorIndex = xlNone
' .Pattern = xlNone
' End With
End If
If cThisRow Then
Range("A" & lRow & ":L" & lRow).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If
End With
Next
End Sub