Changing code to mark requirement "+" for pass and "-" for fail under each scenario that was run and leave it blank otherwise

[Nlhicks]

Option Explicit

Sub Test2()
If ActiveSheet.Name <> "Sheet4" Then
MsgBox "Run this from the Sheet 4.", 64, "Note:"
Exit Sub
End If

Application.ScreenUpdating = False

Dim cellEstelle As Range, strEstelle$, strPassFail$
Dim varFindRequirement As Variant, lngFindRequirement&, lngNextCol&, xCol&
Dim cellEasy As Range, strEasy$
Dim varFindScenario As Variant, lngFindScenario&, lngNextRow&, xRow&

With Sheets("Sheet3")

For Each cellEstelle In Columns(1).SpecialCells(2)
Set varFindRequirement = Nothing
strEstelle = cellEstelle.Value
Set varFindRequirement = .Columns(8).Find(What:=strEstelle, LookIn:=xlFormulas, LookAt:=xlWhole)

For Each cellEasy In Columns(3).SpecialCells(2)
Set varFindScenario = Nothing
strEasy = cellEasy.Value
Set varFindScenario = .Rows(5).Find(What:=cellEasy, LookIn:=xlFormulas, LookAt:=xlWhole)


If Not varFindRequirement Is Nothing Then
lngFindRequirement = varFindRequirement.Row
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 cells(cellEstelle.Row, 2).Value = "Pass" Then
strPassFail = "+"
Else
strPassFail = "-"
End If

For lngFindScenario = 9 To 16
If Len(.cells(lngFindRequirement, lngFindScenario).Value) = 0 And .cells(lngFindRequirement, lngFindScenario).Interior.ColorIndex = -4142 Then .cells(lngFindRequirement, lngFindScenario).Value = strPassFail
Next lngFindScenario
End If
End If
End If
End If

Next cellEasy

Next cellEstelle

End With

Set varFindRequirement = Nothing
Application.ScreenUpdating = True
MsgBox "Completed.", , "Done."

End Sub


This is what the code above is giving me:

Test Tracking Test2 adding new section.xlsm
	H	I	J	K	L	M	N	O	P
5		Abort_12	Cold_Cut_2	Hot_Cut_1	Hot_Cut_3	Omega_1	Pharos_1	Hot_Cut_2	Cold_Cut_1
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
Sheet3

From this data:

Test Tracking Test2 adding new section.xlsm
	A	B	C
1	SPS#	Result	Scenarios
2	D_ANT_SFTY_01	Pass	Abort_12
3	D_ANT_SFTY_03	Fail	Hot_Cut_3
4	BITO_1011	Pass	Pharos_1
5	BITO_1012	Pass	Cold_Cut_1
6	QNTI_01	Fail	Hot_Cut_1
7	QNTI_02	Pass
8	PLT_555	Pass
9	PLT_556	Pass
Sheet4

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C2:C5	Cell Value	duplicates	text	NO
C8	Cell Value	duplicates	text	NO

 

[Nlhicks]

This is what the result should be if the information above is given:

 

[Nlhicks]

I added what the data should present above. Hopefully this helps

 

[Nlhicks]

I did want to mention that both the scenario code and the requirement code work doing what they were designed to do. I want to combine them so that it is still requirements based however it takes the scenario into consideration if that makes sense.

 

[Nlhicks]

Please

 

[Nlhicks]

Pretty Please

 

[bobsan42]

try this:

Option Explicit

Sub Test2()
Dim sh4 As Worksheet, sh3 As Worksheet
Dim cc As Range
Application.ScreenUpdating = False

Dim cellEstelle As Range, strEstelle$, strPassFail$, stResult As String
Dim varFindRequirement As Variant, lngFindRequirement&, lngNextCol&, xCol&
Dim cellEasy As Range, strEasy$
Dim varFindScenario As Variant, lngFindScenario&, lngNextRow&, xRow&

Set sh3 = ThisWorkbook.Worksheets("Sheet3")
Set sh4 = ThisWorkbook.Worksheets("Sheet4")

    For Each cellEstelle In sh4.Columns(1).SpecialCells(2)
        Set varFindRequirement = Nothing
        strEstelle = Trim(cellEstelle.Value)
        strPassFail = Trim(cellEstelle.Offset(, 1).Value)
        
        Set varFindRequirement = sh3.Columns(8).Find(What:=strEstelle, 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)
                        cc.Select
                        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 cellEstelle

Set varFindRequirement = Nothing
Set varFindScenario = Nothing
Set sh3 = Nothing
Set sh4 = Nothing
Set cc = Nothing
Set cellEasy = Nothing
Set cellEstelle = Nothing
    
Application.ScreenUpdating = True
MsgBox "Completed.", , "Done."

End Sub

 

[Nlhicks]

I am getting a run-time error '1004' saying select method of Range class failed at the cc.Select

 

[NoSparks]

That's because you have sheet4 as the active sheet
add sh3.select

                        If varFindScenario.Column And strPassFail = "Pass" Then
                            stResult = "+"
                        Else
                            stResult = "-"
                        End If
                        
                        sh3.Select
                        
                        Set cc = sh3.Cells(lngFindRequirement, lngFindScenario)
                        cc.Select
                        If Len(cc.Value) = 0 And cc.Interior.ColorIndex = -4142 Then cc.Value = stResult
                    End If
                End If

 

[bobsan42]

I am getting a run-time error '1004' saying select method of Range class failed at the cc.Select

Delete this line. It eas for debugging only. Sorry.

 

[bobsan42]

BTW, the code in post 16 doesn't care which is the active sheet. You may start it from any sheet.
Just remove the line cc.Select.