Nlhicks
Board Regular
- Joined
- Jan 8, 2021
- Messages
- 244
- Office Version
- 365
- Platform
- Windows
Sub Test2()
Dim sh4 As Worksheet, sh3 As Worksheet
Dim cc As Range
Application.ScreenUpdating = False
Dim cellESIL As Range, strESIL$, strPassFail$, stResult As String
Dim varFindRequirement As Variant, lngFindRequirement&
Dim cellEasy As Range, strEasy$
Dim varFindScenario As Variant, lngFindScenario&
Set sh3 = ThisWorkbook.Worksheets("Sheet3")
Set sh4 = ThisWorkbook.Worksheets("Sheet4")
For Each cellESIL In sh4.Columns(1).SpecialCells(2)
Set varFindRequirement = Nothing
strESIL = Trim(cellESIL.Value)
strPassFail = Trim(cellESIL.Offset(, 1).Value)
Set varFindRequirement = sh3.Columns(8).Find(What:=strESIL, LookIn:=xlFormulas, LookAt:=xlWhole)
If varFindRequirement Is Nothing Then GoTo skipA
lngFindRequirement = varFindRequirement.Row
For Each cellEasy In sh4.Columns(3).SpecialCells(2)
Set varFindScenario = Nothing
strEasy = cellEasy.Value
Set varFindScenario = sh3.Rows(5).Find(What:=Trim(strEasy), LookIn:=xlFormulas, LookAt:=xlWhole)
If varFindScenario Is Nothing Then GoTo skipB
If Not varFindScenario Is Nothing Then
lngFindScenario = varFindScenario.Column
'Modify thse column number boundaries as needed.
If lngFindRequirement >= 6 And lngFindRequirement <= 19 Then
If lngFindScenario >= 9 And lngFindScenario <= 16 Then
If varFindScenario.Column And strPassFail = "Pass" Then
stResult = "+"
Else
stResult = "-"
End If
Set cc = sh3.Cells(lngFindRequirement, lngFindScenario)
If Len(cc.Value) = 0 And cc.Interior.ColorIndex = -4142 Then cc.Value = stResult
End If
End If
End If
skipB:
Next cellEasy
skipA:
Next cellESIL
Set varFindRequirement = Nothing
Set varFindScenario = Nothing
Set sh3 = Nothing
Set sh4 = Nothing
Set cc = Nothing
Set cellEasy = Nothing
Set cellESIL = Nothing
Application.ScreenUpdating = True
MsgBox "Completed.", , "Done."
End Sub
Dim sh4 As Worksheet, sh3 As Worksheet
Dim cc As Range
Application.ScreenUpdating = False
Dim cellESIL As Range, strESIL$, strPassFail$, stResult As String
Dim varFindRequirement As Variant, lngFindRequirement&
Dim cellEasy As Range, strEasy$
Dim varFindScenario As Variant, lngFindScenario&
Set sh3 = ThisWorkbook.Worksheets("Sheet3")
Set sh4 = ThisWorkbook.Worksheets("Sheet4")
For Each cellESIL In sh4.Columns(1).SpecialCells(2)
Set varFindRequirement = Nothing
strESIL = Trim(cellESIL.Value)
strPassFail = Trim(cellESIL.Offset(, 1).Value)
Set varFindRequirement = sh3.Columns(8).Find(What:=strESIL, LookIn:=xlFormulas, LookAt:=xlWhole)
If varFindRequirement Is Nothing Then GoTo skipA
lngFindRequirement = varFindRequirement.Row
For Each cellEasy In sh4.Columns(3).SpecialCells(2)
Set varFindScenario = Nothing
strEasy = cellEasy.Value
Set varFindScenario = sh3.Rows(5).Find(What:=Trim(strEasy), LookIn:=xlFormulas, LookAt:=xlWhole)
If varFindScenario Is Nothing Then GoTo skipB
If Not varFindScenario Is Nothing Then
lngFindScenario = varFindScenario.Column
'Modify thse column number boundaries as needed.
If lngFindRequirement >= 6 And lngFindRequirement <= 19 Then
If lngFindScenario >= 9 And lngFindScenario <= 16 Then
If varFindScenario.Column And strPassFail = "Pass" Then
stResult = "+"
Else
stResult = "-"
End If
Set cc = sh3.Cells(lngFindRequirement, lngFindScenario)
If Len(cc.Value) = 0 And cc.Interior.ColorIndex = -4142 Then cc.Value = stResult
End If
End If
End If
skipB:
Next cellEasy
skipA:
Next cellESIL
Set varFindRequirement = Nothing
Set varFindScenario = Nothing
Set sh3 = Nothing
Set sh4 = Nothing
Set cc = Nothing
Set cellEasy = Nothing
Set cellESIL = Nothing
Application.ScreenUpdating = True
MsgBox "Completed.", , "Done."
End Sub