I have been asked to make an Excel Macro to determine points based on three words and then color the boxes depending on the range of points so that what can be worked on is quickly determined. I am new to VBA and have done some reading and so far this is what I have come up with. I as hoping someone could let me know if I am on the right track or way off or if I am over complicating this.
This is what I have so far:
Sub Macro_Test()
Dim TotalScore As Integer
'Look through H to determine what word is contained and then add
'a value to the total score
'When I try to add to the TotalScore the addition sign goes away
'(not sure if the .Value is supposed to be used)
If (Sheet1.Columns(2, 8) = "Yes") Then
TotalScore.Value 3
ElseIf (H17 = "Partial") Then
TotalScore.Value 2
ElseIf (H17 = "No") Then
TotalScore.Value 1
'The 70th row in column 8(H) is equal/shows the total score
Sheet1.Columns(70, 8) = TotalScore.Value
'Color depending on the final score, depending on how line above
'works will change to the value in H70
If (TotalScore < 86 And TotalScore > 69) Then
'Find proper color for green
H70.Interior.ColorIndex = 3
ElseIf (TotalScore < 70 And TotalScore > 44) Then
'Find proper color for yellow
H70.Interior.ColorIndex = 2
ElseIf (TotalScore < 45 And TotalScore > 17) Then
'Find proper color for red
H70.Interior.ColorIndex = 1
End Sub
This is what I now have:
Sub Macro_Test()
Dim TotalScore As Integer
'Set the total score to zero
TotalScore = 0
Dim SrchRange As Range
'Make a range that goes from H1 to H69
Set SrchRange = Sheet1.Range("H1", "H69")
'Look through H to determine what word is contained
'and then add a value to the total score
For Each FilledCell In SrchRange
If (FilledCell = "Yes") Then
TotalScore = TotalScore + 3
ElseIf (FilledCell = "Partial") Then
TotalScore = TotalScore + 2
ElseIf (FilledCell = "No") Then
TotalScore = TotalScore + 1
End If
Next Source
'Make it so on sheet one the 72th row under column H
'displays the total score
Range("H72") = TotalScore
'Color depending on the final score, depending on how
'line above works will change to the value in H72
If (TotalScore < 86 And TotalScore > 69) Then
'Find proper color for green
Range("H70").Interior.ColorIndex = 3
ElseIf (TotalScore < 70 And TotalScore > 44) Then
'Find proper color for yellow
Range("H70").Interior.ColorIndex = 2
ElseIf (TotalScore < 45 And TotalScore > 17) Then
'Find proper color for red
Range("H70").Interior.ColorIndex = 1
End If
End Sub
P.S. Should I be double indenting in my code? In VBA it is indented but on here I manually added four spaces to each line. Once again sorry and thank you as I am new to all of this.
I am confused about the 'Next' part after my 'For Each':
Sub Macro_Test()
Dim TotalScore As Integer
'Set the total score to zero
TotalScore = 0
Dim SrchRange As Range
'Make a range that goes from H1 to H69
Set SrchRange = Sheet1.Range("H2:H69")
'Look through H to determine what word is contained and then add a value to the total score
For Each FilledCell In SrchRange
If (FilledCell = "Yes") Then
TotalScore = TotalScore + 3
ElseIf (FilledCell = "Partial") Then
TotalScore = TotalScore + 2
ElseIf (FilledCell = "No") Then
TotalScore = TotalScore + 1
End If
Next FilledItem
'Make it so on sheet one the 72th row under column H displays the total score
Range("H72") = TotalScore
'Color depending on the final score, depending on how line above works will change to the value in H70
If (TotalScore < 86 And TotalScore > 69) Then
'Find proper color for green
Range("H70").Interior.Color = 5287936
ElseIf (TotalScore < 70 And TotalScore > 44) Then
'Find proper color for yellow
Range("H70").Interior.Color = 65535
ElseIf (TotalScore < 45 And TotalScore > 17) Then
'Find proper color for red
Range("H70").Interior.Color = 255
End If
End Sub
I am almost done. I want to make it so that Whenever a yes is in column H that column K for each one is colored. Would I make a separate For Each or is there a way to put it with the one I currently have?
Sub Color_Macro()
Dim TotalScore As Integer
'Set the total score to zero
TotalScore = 0
Dim SrchRange As Range
'Make a range that goes from H20 to H69
Set SrchRange = Sheet1.Range("H20:H69")
'Dim SrchRange2 As Range
'Range for the For Each for colors
'Set SrchRange2 = Sheet1.Range("K20:K69")
'Look through H to determine what word is contained
'and then add a value to the total score
For Each FilledCell In SrchRange
If (FilledCell = "Yes") Then
TotalScore = TotalScore + 5
'I am thinking of putting it in this for each
'and from there set the R cell of the same row to green
'so do I make a new range and implement it or what
ElseIf (FilledCell = "Partial") Then
TotalScore = TotalScore + 3
ElseIf (FilledCell = "No") Then
TotalScore = TotalScore + 1
End If
Next FilledCell
'Make it so on sheet one the 70th row under
'column H displays the total score
Range("H70") = TotalScore
If (TotalScore < 86 And TotalScore > 69) Then
'Find proper color for green
Range("K70").Interior.Color = 5287936
ElseIf (TotalScore < 70 And TotalScore > 44) Then
'Find proper color for yellow
Range("K70").Interior.Color = 65535
ElseIf (TotalScore < 45 And TotalScore > 17) Then
'Find proper color for red
Range("K70").Interior.Color = 255
End
End Sub
I greatly appreciate all of the help!
If someone else has a problem like that and they want to see the finished product: Sub Color_Macro()
Dim TotalScore As Integer
'Set the total score to zero
TotalScore = 0
Dim SrchRange As Range
'Make a range that goes from H20 to H69
Set SrchRange = Sheet1.Range("H20:H69")
'Dim SrchRange2 As Range
'Range for the For Each for colors
'Set SrchRange2 = Sheet1.Range("K20:K69")
'Look through H to determine what word is contained
'and then add a value to the total score
For Each FilledCell In SrchRange
If (FilledCell = "Yes") Then
TotalScore = TotalScore + 5
'Offset it to go three to the
'right and fill in a color
FilledCell.Offset(0, 3).Interior.Color = 5287936
ElseIf (FilledCell = "Partially") Then
TotalScore = TotalScore + 3
FilledCell.Offset(0, 3).Interior.Color = 65535
ElseIf (FilledCell = "No") Then
TotalScore = TotalScore + 1
FilledCell.Offset(0, 3).Interior.Color = 255
End If
Next FilledCell
'Make it so on sheet one the 70th row under
'column H displays the total score
Range("H70") = TotalScore
If (TotalScore < 86 And TotalScore > 69) Then
'Find proper color for green
Range("K70").Interior.Color = 5287936
ElseIf (TotalScore < 70 And TotalScore > 44) Then
'Find proper color for yellow
Range("K70").Interior.Color = 65535
ElseIf (TotalScore < 45 And TotalScore > 17) Then
'Find proper color for red
Range("K70").Interior.Color = 255
End If
End Sub
TotalScore.Value 3?? TotalScore is an Integer so follow Wayne's instructions.Sheet1.Columns(70, 8)?? This should useCellsinstead ofColumns.H17andH70?? UseRangeorCells.TotalScore < 86 And TotalScore > 69?? Not sure how you got from trying to assign values of 1, 2, and 3 to now having values in the 70s... If you are trying to add up checks on multiple cells, you need to rework the top part.