CODEWITHSUNDEEP
excelvba
user2211547
user2211547

Reputation: 21

VBA to clear contents of cell if range is empty

I have a code that works pretty well except for a flaw. It checks for the text in a range and returns a text in the adjacent cell. I want it return a blank cell (Column B) if the adjacent range rows (Column C to G) are empty. This is the code below

Sub status_summary()
    Dim r As Integer
    Dim fail As Boolean
    Dim mrit As Boolean
    Dim pass As Boolean

    For r = 2 To 6
        If Range("C" & r) = "Failed" Then fail = True
        If Range("C" & r) = "Merit" Then mrit = True
        If Range("C" & r) = "Pass" Then pass = True

        If Range("D" & r) = "Failed" Then fail = True
        If Range("D" & r) = "Merit" Then mrit = True
        If Range("D" & r) = "Pass" Then pass = True

        If Range("E" & r) = "Failed" Then fail = True
        If Range("E" & r) = "Merit" Then mrit = True
        If Range("E" & r) = "Pass" Then pass = True

        If Range("F" & r) = "Failed" Then fail = True
        If Range("F" & r) = "Merit" Then mrit = True
        If Range("F" & r) = "Pass" Then pass = True

        If Range("G" & r) = "Failed" Then fail = True
        If Range("G" & r) = "Merit" Then mrit = True
        If Range("G" & r) = "Pass" Then pass = True

        If pass = True Then Range("B" & r) = "Pass"
        If mrit = True Then Range("B" & r) = "Merit"
        If fail = True Then Range("B" & r) = "Failed"

        fail = False
        mrit = False
        pass = False

    Next r

    MsgBox ("All Done")
End Sub

Upvotes: 1

Views: 2083

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149277

You don't need such a big code or VBA for this :)

NON VBA Method

Using Formula

This goes in Cell B2. Simply copy it down.

=IF(COUNTA(C2:G2)=0,"",IF(COUNTIF(C2:G2,"Failed")>0,"Failed",IF(COUNTIF(C2:G2,"Merit")>0,"Merit",IF(COUNTIF(C2:G2,"Pass")>0,"Pass",""))))

enter image description here

However if you still want VBA then see the below.

VBA METHOD

A) Shortening your code

Sub status_summary()
    Dim r As Integer

    For r = 2 To 6
        If Application.WorksheetFunction.CountA(Range("C" & r & ":G" & r)) = 0 Then
            Range("B" & r) = ""
        ElseIf Application.WorksheetFunction.CountIf(Range("C" & r & ":G" & r), "Failed") > 0 Then
            Range("B" & r) = "Failed"
        ElseIf Application.WorksheetFunction.CountIf(Range("C" & r & ":G" & r), "Merit") > 0 Then
            Range("B" & r) = "Merit"
        ElseIf Application.WorksheetFunction.CountIf(Range("C" & r & ":G" & r), "Pass") > 0 Then
            Range("B" & r) = "Pass"
        End If
    Next r

    MsgBox ("All Done")
End Sub

B) Using Formulas in VBA

Sub status_summary()
    Range("B2:B6").Formula = "=IF(COUNTA(C2:G2)=0,"""",IF(COUNTIF(C2:G2,""Failed"")>0,""Failed"",IF(COUNTIF(C2:G2,""Merit"")>0,""Merit"",IF(COUNTIF(C2:G2,""Pass"")>0,""Pass"",""""))))"

    MsgBox ("All Done")
End Sub

Upvotes: 1

Related Questions