0

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
4
  • 1. Since you 'Dim' TotalScore, replace references to '.Value' with ' = = ' to set the variable. 2. You are missing two 'End If' 3. Are you supposed to look thru multiple rows? 4. Also, references to cells are not correct. Commented Aug 6, 2014 at 18:59
  • Typo: ... with ' = ' Commented Aug 6, 2014 at 19:14
  • Just on a surface look, syntactically wrong and inconsistent even within itself. TotalScore.Value 3?? TotalScore is an Integer so follow Wayne's instructions. Sheet1.Columns(70, 8)?? This should use Cells instead of Columns. H17 and H70?? Use Range or Cells. 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. Commented Aug 6, 2014 at 20:56
  • Yes I am trying to add them up. I was trying to do a += but it told me to get rid of the equal sign and then it just deleted the addition sign. This is my first time every using this language so I appreciate all of the help. Commented Aug 6, 2014 at 21:10

1 Answer 1

1

Try this out, I think I understand what you're tyring to do but your explantion is a little vague

Sub test()

Dim SrchRng As Range
Set SrchRng = ActiveSheet.Range("H2:H69")
Dim TotalScore As Integer
TotalScore = 0

For Each Source In SrchRng
    If Source = "yes" Then
        TotalScore = TotalScore + 3
        Source.Offset(0, 3).Interior.Color = 5287936
    ElseIf Source = "partial" Then
        TotalScore = TotalScore + 2
    ElseIf Source = "no" Then
        TotalScore = TotalScore + 1
    End If
Next Source

If (TotalScore < 86 And TotalScore > 69) Then
        Range("H70").Interior.Color = 5287936
    ElseIf (TotalScore < 70 And TotalScore > 44) Then
        Range("H70").Interior.Color = 65535
    ElseIf (TotalScore < 45 And TotalScore > 17) Then
        Range("H70").Interior.Color = 255
End If

End Sub
Sign up to request clarification or add additional context in comments.

19 Comments

I appreciate your post mrbungle. I am going to try avoiding to copy code to ensure I completely understand what I am doing. I was not sure if there was a shortcut for the TotalScore adding, such as += instead of = TotalScore +. My apologies for my unclear explanation. It is supposed to determine what word is in each cell in the H column to determine the points to add (and from what I see it seems you understood that). I have followed your For Each but it seems my "Next Source" is not working as intended. Do I post my code as another answer to show or in a comment? I am new to all of this.
Your 'Next Source' should be 'Next FilledItem' in your second attempt and use the color values I used.
Also, follow my syntax for the Set Range
Sorry, 'Next FilledCell'
This whole 'Next' thing is new to me, is there a place I can find all of them and how it works?
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.