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]

I spent about 10 hours this weekend just trying to play with the code to get it to work and I am not sure what to do to make it work as I want it to. If someone has an idea please share.

 

[bobsan42]

(I will leave aside the code improvements for the moment)
I may not be correctly getting the idea of the code, but what i think is:
I assume You have to get a single Plus, Minus or Null in a cell in sheet3 for each line in sheet4. If this is correct:

1. you should not be looping celleasy in the loop of cellestelle. you just have to take a value with cellestelle.offset(,2).value
2. the scenarios in Sheet4, column C may contain an extra space at the end so change your Find like this:

            Set varFindScenario = .Rows(5).Find(What:=Trim(strEasy), LookIn:=xlFormulas, LookAt:=xlWhole)

3. Since you only need 1 value to put in sheet4 then don't try to put 8. Ditch the loop For lngFindScenario = 9 To 16

May I suggest to clear the cells fill before you run the sub - test it first without the yellow.
Try the code like this:

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("Sheet5")

    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 cellEasy = cellEstelle.Offset(, 2)
            Set varFindScenario = Nothing
            strEasy = cellEasy.Value
            Set varFindScenario = .Rows(5).Find(What:=Trim(strEasy), 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

 

[Nlhicks]

I ran the code above and this is what I got in my spreadsheet:

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

 

[Nlhicks]

What do you think?

 

[Nlhicks]

With no yellow I get:

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

 

[bobsan42]

Ok, but I still don't understand - is this what you're after or not?

 

[Peter_SSs]

Further to what @bobsan42 has said:
You have given us your code that does not do what you want.
You have given us your results which are not what you want.
You have given us nothing else, so we have no idea what you actually started with in Sheet3 or what you would like to finish with in Sheet3.

What about you give us those two mini-sheets with XL2BB?

BTW, when posting vba code in the forum, please indent your code in your vba editor and preserve that formatting by using the available code tags. My signature block below has more about that.

 

[Nlhicks]

Okay, here is what I started with, This code took a Scenario and its Pass/Fail Status and put a "+" or "-" in every empty cell in the column but now I would like to use the requirement based tracking but only put the "+" in the empty cell if the scenario actually got ran:
Option Explicit

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

Application.ScreenUpdating = False
Dim cellEstelle As Range, strEstelle$, strPassFail$
Dim varFindScenario As Variant, lngFindScenario&, lngNextRow&, xRow&

With Sheets("Requirement Burndown Table")

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

If Not varFindScenario Is Nothing Then
lngFindScenario = varFindScenario.Column
'Modify thse column number boundaries as needed.
If lngFindScenario >= 5 And lngFindScenario <= 26 Then
If cells(cellEstelle.Row, 2).Value = "Pass" Then
strPassFail = "+"
Else
strPassFail = "-"
End If

For xRow = 6 To 18
If Len(.cells(xRow, lngFindScenario).Value) = 0 And .cells(xRow, lngFindScenario).Interior.ColorIndex = -4142 Then .cells(xRow, lngFindScenario).Value = strPassFail
Next xRow

End If
End If
Next cellEstelle

End With

Set varFindScenario = Nothing
Application.ScreenUpdating = True
MsgBox "Completed.", , "Done."
End Sub

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		-				+
Requirement Burndown Table

Test Tracking Test2 adding new section.xlsm
	A	B	C
1	Run One
2		Pass	Abort_12
3		Fail	Hot_Cut_1
4		Pass	Cold_Cut_1
5		Fail	Cold_Cut_2
6		Pass	Pharos_1
Estelle Tracking

I changed it to look at requirements and take the Pass/Fail Status and fill across each row:
Option Explicit

Sub Test2()
If ActiveSheet.Name <> "Sheet2" 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("Sheet1")

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

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		+				+
Sheet1

Test Tracking Test2 adding new section.xlsm
	A	B	C
1	SPS#	Result	Scenarios ran
2	D_ANT_SFTY_01	Pass	Abort_12
3	D_ANT_SFTY_02	Fail	Hot_Cut_1
4	D_ANT_SFTY_03	Pass	Hot_Cut_3
5	BITO_1010	Pass	Hot_Cut_2
6	BITO_1011	Pass
7	BITO_1012	Pass
8	BITO_1013	Pass
9	QNTI_01	Fail
10	QNTI_02	Pass
11	QNTI_03	Pass
12	PLT_555	Pass
13	PLT_556	Fail
14	PLT_557	Pass
Sheet2

 

[Peter_SSs]

You have given us your code that does not do what you want.

It seems that you have given us two more versions of that

You have given us your results which are not what you want.

It seems that you have given us two more versions of that

You have given us nothing else, so we have no idea what you actually started with in (your result sheet) or what you would like to finish with in (your result sheet).

This is still the case.

BTW, when posting vba code in the forum, please indent your code in your vba editor and preserve that formatting by using the available code tags. My signature block below has more about that.

This is still the case.

Please do not post any more code that does not do what you want. That does not help us at all to make a suggestion for you.

This is my suggestion. Suppose this is the data:

1. Show us a mini-sheet of the whatever is in the result sheet before any code is run.

2. Show us a mini-sheet of the result sheet as you want it to look after the code is run, with the results entered in manually.