CODEWITHSUNDEEP
vbaexcel
Sakvad
Sakvad

Reputation: 73

Reduce Code Redundancy VBA (Specific Code With Example)

I am very new to VBA (I started two days ago) and was given an assignment for an internship. The program I made had made a point system based on words in the cells and then assigned it colors. There were different sections separated by a an entire row and I did not want to color that row. Instead I made five different ranges and a copy of each of my IF statements but I was not sure if I should have made a loop or something to skip those black rows that I did not want to color. Here is my code and if you need a better explanation of what I am trying to explain just ask.

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 SrchRange1 = Sheet1.Range("H20:H24")
    Dim SrchRange2 As Range
    Set SrchRange2 = Sheet1.Range("H30:H37")
    Dim SrchRange3 As Range
    Set SrchRange3 = Sheet1.Range("H42:H49")
    Dim SrchRange4 As Range
    Set SrchRange4 = Sheet1.Range("H54:H59")
    Dim SrchRange5 As Range
    Set SrchRange5 = Sheet1.Range("H64:H72")


    'Look through H to determine what word is contained
    'and then add a value to the total score
    For Each FilledCell In SrchRange1
        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 = RGB(146, 208, 80)
        ElseIf (FilledCell = "Partially") Then
            TotalScore = TotalScore + 3
            FilledCell.Offset(0, 3).Interior.Color = RGB(255, 255, 0)
        ElseIf (FilledCell = "No") Then
            TotalScore = TotalScore + 1
            FilledCell.Offset(0, 3).Interior.Color = RGB(255, 0, 0)
        ElseIf (FilledCell = "") Then
            FilledCell.Offset(0, 3).Interior.Color = RGB(238, 236, 225)
        End If
    Next FilledCell

    For Each FilledCell In SrchRange2
        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 = RGB(146, 208, 80)
        ElseIf (FilledCell = "Partially") Then
            TotalScore = TotalScore + 3
            FilledCell.Offset(0, 3).Interior.Color = RGB(255, 255, 0)
        ElseIf (FilledCell = "No") Then
            TotalScore = TotalScore + 1
            FilledCell.Offset(0, 3).Interior.Color = RGB(255, 0, 0)
        ElseIf (FilledCell = "") Then
            FilledCell.Offset(0, 3).Interior.Color = RGB(238, 236, 225)
        End If
    Next FilledCell

    For Each FilledCell In SrchRange3
        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 = RGB(146, 208, 80)
        ElseIf (FilledCell = "Partially") Then
            TotalScore = TotalScore + 3
            FilledCell.Offset(0, 3).Interior.Color = RGB(255, 255, 0)
        ElseIf (FilledCell = "No") Then
            TotalScore = TotalScore + 1
            FilledCell.Offset(0, 3).Interior.Color = RGB(255, 0, 0)
        ElseIf (FilledCell = "") Then
            FilledCell.Offset(0, 3).Interior.Color = RGB(238, 236, 225)
        End If
    Next FilledCell

    For Each FilledCell In SrchRange4
        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 = RGB(146, 208, 80)
        ElseIf (FilledCell = "Partially") Then
            TotalScore = TotalScore + 3
            FilledCell.Offset(0, 3).Interior.Color = RGB(255, 255, 0)
        ElseIf (FilledCell = "No") Then
            TotalScore = TotalScore + 1
            FilledCell.Offset(0, 3).Interior.Color = RGB(255, 0, 0)
        ElseIf (FilledCell = "") Then
            FilledCell.Offset(0, 3).Interior.Color = RGB(238, 236, 225)
        End If
    Next FilledCell

    For Each FilledCell In SrchRange5
        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 = RGB(146, 208, 80)
        ElseIf (FilledCell = "Partially") Then
            TotalScore = TotalScore + 3
            FilledCell.Offset(0, 3).Interior.Color = RGB(255, 255, 0)
        ElseIf (FilledCell = "No") Then
            TotalScore = TotalScore + 1
            FilledCell.Offset(0, 3).Interior.Color = RGB(255, 0, 0)
        ElseIf (FilledCell = "") Then
            FilledCell.Offset(0, 3).Interior.Color = RGB(238, 236, 225)
        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
        Range("K70").Interior.Color = RGB(146, 208, 80)
    ElseIf (TotalScore < 70 And TotalScore > 44) Then
        Range("K70").Interior.Color = RGB(255, 255, 0)
    ElseIf (TotalScore < 45 And TotalScore > 17) Then
        Range("K70").Interior.Color = RGB(255, 0, 0)
    ElseIf (TotalScore < 17) Then
        Range("K70").Interior.Color = RGB(238, 236, 225)
    End If

End Sub

Also, just out of curiosity, how common is this language/frequently used?

Upvotes: 0

Views: 329

Answers (1)

L42
L42

Reputation: 19727

Try this:

Sub ColorMacro()
    Dim TotalScore As Long, sr As Range, c As Range
    Dim fr1 As Range, fr2 As Range, fr3 As Range, fr4 As Range
    Dim emptyrow As Boolean

    Set sr = ThisWorkbook.Sheets("Sheet1").Range("H20:H72")
    For Each c In sr
        emptyrow = IIf(Application.WorksheetFunction.CountA(c.EntireRow) = 0, _
             True, False)
        Select Case True
        Case UCase(c.Value) = "YES"
            TotalScore = TotalScore + 5
            If fr1 Is Nothing Then Set fr1 = c.Offset(0, 3) _
                Else Set fr1 = Union(fr1, c.Offset(0, 3))
        Case UCase(c.Value) = "PARTIALLY"
            TotalScore = TotalScore + 3
            If fr2 Is Nothing Then Set fr2 = c.Offset(0, 3) _
                Else Set fr2 = Union(fr2, c.Offset(0, 3))
        Case UCase(c.Value) = "NO"
            TotalScore = TotalScore + 1
            If fr3 Is Nothing Then Set fr3 = c.Offset(0, 3) _
                Else Set fr3 = Union(fr3, c.Offset(0, 3))
        Case c.Value = "" And Not emptyrow
            If fr4 Is Nothing Then Set fr4 = c.Offset(0, 3) _
                Else Set fr4 = Union(fr4, c.Offset(0, 3))
        End Select
    Next

    If Not fr1 Is Nothing Then fr1.Interior.Color = RGB(146, 208, 80)
    If Not fr2 Is Nothing Then fr2.Interior.Color = RGB(255, 255, 0)
    If Not fr3 Is Nothing Then fr3.Interior.Color = RGB(255, 0, 0)
    If Not fr4 Is Nothing Then fr4.Interior.Color = RGB(238, 236, 225)
End Sub

You can use the rest of your code to assign the value of TotalScore to any range.
As well as the conditions which you can also replace with Select Case Clause which is ideal in multiple conditions. Something like below:

    Select Case True
    Case TotalScore < 86 And TotalScore > 69
        Sheet1.Range("K70").Interior.Color = RGB(146, 208, 80)
    Case TotalScore < 70 And TotalScore > 44
        Sheet1.Range("K70").Interior.Color = RGB(255, 255, 0)
    Case TotalScore < 45 And TotalScore > 17
        Sheet1.Range("K70").Interior.Color = RGB(255, 0, 0)
    Case TotalScore < 17
        Sheet1.Range("K70").Interior.Color = RGB(238, 236, 225)
    End Select

Take note that I just made the Range Objects explicit (includes either sheetname or sheetcodename).
I hope that it didn't confuse you in any way. If you have questions, just comment it.
As for your question as how frequent this language is being used, well that depends on what field you are.
But as long as you're using Microsoft Office, then this language is used a lot at least for some.

Upvotes: 1

Related Questions