Nlhicks
Board Regular
- Joined
- Jan 8, 2021
- Messages
- 244
- Office Version
- 365
- Platform
- Windows
Code so far that is not quite working like I would like it to, the bolded section is where I think the problem lies:
Sub Test2()
If ActiveSheet.Name <> "Sheet2" Then
MsgBox "Run this from the Sheet 2.", 64, "Note:"
Exit Sub
End If
Application.ScreenUpdating = False
Dim cellEstelle As Range, strEstelle$, strPassFail$
Dim varFindScenario As Variant, lngFindScenario&, lngNextCol&, xCol&
With Sheets("Sheet1")
For Each cellEstelle In Columns(1).SpecialCells(2)
Set varFindScenario = Nothing
strEstelle = cellEstelle.Value
Set varFindScenario = .Columns(8).Find(What:=strEstelle, LookIn:=xlFormulas, LookAt:=xlWhole)
If Not varFindScenario Is Nothing Then
lngFindScenario = varFindScenario.Row
'Modify thse column number boundaries as needed.
If lngFindScenario >= 9 And lngFindScenario <= 16 Then
If Cells(cellEstelle.Row, 2).Value = "Pass" Then
strPassFail = "+"
Else
strPassFail = "-"
End If
For xCol = 6 To 20
If Len(.Cells(xCol, lngFindScenario).Value) = 0 And .Cells(xCol, lngFindScenario).Interior.ColorIndex = -4142 Then .Cells(xCol, lngFindScenario).Value = strPassFail
Next xCol
End If
End If
Next cellEstelle
End With
Set varFindScenario = Nothing
Application.ScreenUpdating = True
MsgBox "Completed.", , "Done."
End Sub
Sheet1:
Sheet2:
Sub Test2()
If ActiveSheet.Name <> "Sheet2" Then
MsgBox "Run this from the Sheet 2.", 64, "Note:"
Exit Sub
End If
Application.ScreenUpdating = False
Dim cellEstelle As Range, strEstelle$, strPassFail$
Dim varFindScenario As Variant, lngFindScenario&, lngNextCol&, xCol&
With Sheets("Sheet1")
For Each cellEstelle In Columns(1).SpecialCells(2)
Set varFindScenario = Nothing
strEstelle = cellEstelle.Value
Set varFindScenario = .Columns(8).Find(What:=strEstelle, LookIn:=xlFormulas, LookAt:=xlWhole)
If Not varFindScenario Is Nothing Then
lngFindScenario = varFindScenario.Row
'Modify thse column number boundaries as needed.
If lngFindScenario >= 9 And lngFindScenario <= 16 Then
If Cells(cellEstelle.Row, 2).Value = "Pass" Then
strPassFail = "+"
Else
strPassFail = "-"
End If
For xCol = 6 To 20
If Len(.Cells(xCol, lngFindScenario).Value) = 0 And .Cells(xCol, lngFindScenario).Interior.ColorIndex = -4142 Then .Cells(xCol, lngFindScenario).Value = strPassFail
Next xCol
End If
End If
Next cellEstelle
End With
Set varFindScenario = Nothing
Application.ScreenUpdating = True
MsgBox "Completed.", , "Done."
End Sub
Sheet1:
Test Tracking Test2 adding new section.xlsm | |||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|
H | I | J | K | L | M | N | O | P | |||
6 | D_ANT_SFTY_01 | ||||||||||
7 | D_ANT_SFTY_02 | ||||||||||
8 | D_ANT_SFTY_03 | ||||||||||
9 | BITO_1010 | ||||||||||
10 | BITO_1011 | ||||||||||
11 | BITO_1012 | ||||||||||
12 | BITO_1013 | ||||||||||
13 | QNTI_01 | ||||||||||
14 | QNTI_02 | ||||||||||
15 | QNTI_03 | ||||||||||
16 | PLT_555 | ||||||||||
17 | PLT_556 | ||||||||||
18 | PLT_557 | ||||||||||
19 | DPIP_01 | ||||||||||
Sheet1 |
Sheet2:
Test Tracking Test2 adding new section.xlsm | ||||
---|---|---|---|---|
A | B | |||
1 | One | |||
2 | D_ANT_SFTY_01 | Pass | ||
3 | D_ANT_SFTY_02 | Fail | ||
4 | D_ANT_SFTY_03 | Pass | ||
5 | BITO_1010 | Pass | ||
6 | BITO_1011 | Pass | ||
7 | BITO_1012 | Pass | ||
8 | BITO_1013 | Pass | ||
9 | QNTI_01 | Pass | ||
10 | QNTI_02 | Fail | ||
11 | QNTI_03 | Pass | ||
12 | PLT_555 | Pass | ||
13 | PLT_556 | Pass | ||
14 | PLT_557 | Pass | ||
15 | DPIP_01 | Fail | ||
Sheet2 |