Bijan Sanchez
Bijan Sanchez

Reputation: 39

How to make an error flagging array in VBA and translate all array elements as a string message?

In Excel I'm looping through some data in a sheet called "temp" and checking if any cell is red (this indicates an error).

Before this code below, I take my data (2 columns of data, 8 rows long) in Sheet "temp" through a test and assign passed data as green, ie: RGB(0, 200, 0). Then I want to verify that all 8 rows passed in another sheet called "main":

    dim errorz(0) as variant
    dim errorz_string as string
    
    for i = 1 to 8
    
     if sheets("temp").cells(i, 2).interior.color <> RGB(0, 200, 0) then
     
     sheets("temp").cells(i, 3) = "Not verified"
     sheets("temp").cells(i, 3).interior.color = RGB(200, 0, 0)
    
     redim preserve errorz( UBound(errorz)-LBound(errorz) + 1 )
     errorz( UBound(errorz)-LBound(errorz) ) = sheets("temp").cells(i, 1)
    
     end if
    
    next i
    
    if  UBound(errorz) - LBound(errorz) = 0 then
     sheets("main").cells(1,1) = "Yes all 8 in temp verified."
    end if
    
    if  UBound(errorz) - LBound(errorz) <> 0 then
    
     for j = LBound(info.errorz) to UBound(info.errorz)
      info.errorz(j) = "'" & info.errorz(j) & "'"
     next j

     errorz_string = Join(info.errorz, ",")
     sheets("main").cells(1,1) = "No, missing " & errorz_string & " in temp"

    end if
    
    redim errorz(0)
    errorz_string = ""

I've never used arrays before and am confused about redefining an array to be empty and length 0, and then increasing the length to 1 in a loop. For example, does redim errorz(0) create an empty array of length 0?

Also, initially when this array is of length 0, would "UBound(errorz)-LBound(errorz)" return 0 or 1 or an error?

Upvotes: 1

Views: 56

Answers (1)

CHH
CHH

Reputation: 168

I think the use of an array is not quite helpful for your use case here. I'd recommend using a collection instead. I have rewritten your code to that end:

Sub program()

Dim errorz_string As String, i, j
Dim colErrorResults As New Collection, error_field

For i = 1 To 8

     If Sheets("temp").Cells(i, 2).Interior.Color <> RGB(0, 200, 0) Then
     
         Sheets("temp").Cells(i, 3) = "Not verified"
         Sheets("temp").Cells(i, 3).Interior.Color = RGB(200, 0, 0)
        
         colErrorResults.Add Sheets("temp").Cells(i, 1)
    
     End If

Next i

If colErrorResults.Count = 0 Then
    Sheets("main").Cells(1, 1) = "Yes all 8 in temp verified."
End If

If colErrorResults.Count <> 0 Then

    For Each error_field In colErrorResults
    
        errorz_string = errorz_string & "'" & error_field & "', "
    
    Next error_field
    
    'remove final ',
    errorz_string = Left(errorz_string, Len(errorz_string) - 2)
    
    Sheets("main").Cells(1, 1) = "No, missing " & errorz_string & " in temp"

End If

End Sub

and another Version where I did some refactoring to use naming of sheets and the guard pattern:

'if you have custom colors, you can use 'Debug.Print RGB(200, 0, 0)' to find out what the numeric value is.
Private Const GREEN = 51200
Private Const RED = 200

Sub program2()

Dim errorz_string As String, i
Dim colErrorResults As New Collection, error_field

For i = 1 To 8
    
    'select the sheet in the project overview, press F4 and give it a name so you don't have to reference it by its display name. That way the display name can be renamed and your code still works
    With wsTempSheet
        
        'Fewer nestings are easier to read. Although "goto" is frowned upon, it allows you to use the guard pattern
        If .Cells(i, 2).Interior.Color = GREEN Then GoTo nextLine
        
        .Cells(i, 3) = "Not verified"
        .Cells(i, 3).Interior.Color = RED
        
        colErrorResults.Add .Cells(i, 1)

    End With
    
nextLine:
Next i

If colErrorResults.Count = 0 Then
    wsMain.Cells(1, 1) = "Yes all 8 in temp verified."
    'here you can exit the sub so you can remove one if nesting
    Exit Sub
End If


For Each error_field In colErrorResults

    errorz_string = errorz_string & "'" & error_field & "', "

Next error_field

'remove final ',
errorz_string = Left(errorz_string, Len(errorz_string) - 2)

wsMain.Cells(1, 1) = "No, missing " & errorz_string & " in temp"

End Sub

Upvotes: 1

Related Questions