Iterating through a range of cells with a message at the end

[Bartholomeu]

I have data in two columns - column A and column B. Values in column b can be either 0, 5 or 6. I want to iterate through all the cells that have data in column B. If the value of a particular cell is 0, then I want to add the value from the cell to the left of it to an array; if it is <>0, then I just want to go on to the next cell. Once I have finished the iteration, I want a Message Box to appear depending on if the array is empty or not. In the array is empty, then the message should be "No missing data"; if the array has data, then "Missing data for: " + the values stored within the array.

I've never really worked with arrays in VBA so I'm not too sure how to proceed.

This is how I've structured the code so far:

Sub Checker()
  

I'm using Microsoft 365.
    
    Dim dataRange As Range
    Dim cell As Range
    Dim dataArray() As Variant
   

  
    ' Define the range starting from B2 to the last cell with data in column B
    Set dataRange = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)

    ' Iterate through the range
    For Each cell In dataRange
    
        If cell = 0 Then
            ' If the data value in the cell is 0, add the value of the cell to the left to the array
            ReDim Preserve dataArray(0 To UBound(dataArray) + 1)
            dataArray(UBound(dataArray)) = cell.Offset(0, -1).Value
        End If
        
    Next cell

    ' Check the array
    If IsEmpty(dataArray) Then
        ' If the array is empty, show a message box
        MsgBox "No store data is missing."
    Else
        ' If the array has data, construct the missingData string
        For i = 0 To UBound(dataArray)
            missingData = missingData & dataArray(i) & ", "
        Next i
        ' Remove the trailing comma and space
        missingData = Left(missingData, Len(missingData) - 2)
        ' Show a message box with missing data
        MsgBox "Data missing from: " & missingData
    End If
End Sub

When I run the code I get an Out of Range Error on the ReDim line, which I'm not quite sure why.

I think I've not missed anything in the code, so I'm not sure what's going on.

Check_data.xlsm

I'm using Microsoft 365.

[Aflatoon]

Here's one way:

Sub Checker()   
    
    Dim dataRange As Variant
    Dim StoreData
   Dim dataOut() As String
   Dim counter As Long


    ' Define the range starting from B2 to the last cell with data in column B
    With Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
      dataRange = .Value
      StoreData = .Offset(, -1).Value
      ReDim dataOut(1 To UBound(StoreData, 1))
   End With


    ' Iterate through the array
    Dim idx As Long
    For idx = LBound(dataRange, 1) To UBound(dataRange, 1)
      
    
        If dataRange(idx, 1) = 0 Then
            ' If the data value in the cell is 0, add the value of the cell to the left to the array
            counter = counter + 1
            dataOut(counter) = StoreData(idx, 1)
        End If
        
    Next idx


    ' Check the array
    If counter = 0 Then
        ' If the array is empty, show a message box
        MsgBox "No store data is missing."
    Else
        ' If the array has data, construct the missingData string
        ReDim Preserve dataOut(1 To counter)
        missingData = Join(dataOut, ",")
        ' Show a message box with missing data
        MsgBox "Data missing from: " & missingData
    End If
End Sub

[Bartholomeu]

Aflatoon:

As you were posting your reply, I actually found a similar way to do it, only using a boolean flag.

Sub Checker()
   
    
    Dim dataRange As Range
    Dim cell As Range
    Dim dataArray() As Variant
    Dim initialized As Boolean 'Flag to track initialization of array
   

  
    ' Define the range starting from B2 to the last cell with data in column B
    Set dataRange = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    
    'Initialize flag
    initialized = False
    

    ' Iterate through the range
    For Each cell In dataRange
        
        If cell = 0 Then
        
            If Not initialized Then
                'Initiliaze dataArray only once
                ReDim dataArray(0)
                initialized = True
            End If
                
                ' If the data value in the cell is 0, add the value of the cell to the left to the array
                ReDim Preserve dataArray(0 To UBound(dataArray) + 1)
                dataArray(UBound(dataArray)) = cell.Offset(0, -1).Value
            End If
        
    Next cell

    ' Check the array
    If initialized = False Then
        ' If the array is empty, show a message box
        MsgBox "No store data is missing."
    Else
        ' If the array has data, construct the missingData string
        For i = 0 To UBound(dataArray)
            missingData = missingData & dataArray(i) & ", "
        Next i
        ' Remove the trailing comma and space
        missingData = Left(missingData, Len(missingData) - 2)
        ' Show a message box with missing data
        MsgBox "Data missing from: " & missingData
    End If
End Sub

[p45cal]

If this is an exercise for working with arrays, fine. Otherwise, you don't need to use them:

Sub Checker()
Dim cell As Range
Dim missingData
' Iterate through the range
For Each cell In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
  If cell = 0 Then
    ' If the data value in the cell is 0, add the value of the cell to the missingdata string
    missingData = missingData & cell.Offset(0, -1).Value & ", "
  End If
Next cell
' Check the string:
If IsEmpty(missingData) Then ' If missingData is empty, show a message box
  MsgBox "No store data is missing."
Else
  MsgBox "Data missing from: " & Left(missingData, Len(missingData) - 2)
End If
End Sub

[Bartholomeu]

Isn't your missingData variable acting like an array in this code?

If this is an exercise for working with arrays, fine. Otherwise, yoiu don't need to use them:

Sub Checker()
Dim cell As Range
Dim missingData
' Iterate through the range
For Each cell In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
  If cell = 0 Then
    ' If the data value in the cell is 0, add the value of the cell to the missingdata string
    missingData = missingData & cell.Offset(0, -1).Value & ", "
  End If
Next cell
' Check the string:
If IsEmpty(missingData) Then ' If missingData is empty, show a message box
  MsgBox "No store data is missing."
Else
  MsgBox "Data missing from: " & Left(missingData, Len(missingData) - 2)
End If
End Sub

[Aflatoon]

Arrays should be faster than looping cell by cell and using string concatenation.

[Aflatoon]

Annoyingly:
https://excelforum.com/excel-program...t-the-end.html

[p45cal]

Isn't your missingData variable acting like an array in this code?

In a far-fetched way, yes. It's acting in exactly the same way as your missingdata variable in the original code (a string), without the need for the intervening true array dataArray().

[p45cal]

Arrays should be faster than looping cell by cell and using string concatenation.

Absolutely, (although I didn't realise that speed was the problem) your code in msg#2 only has 2 reads from the sheet (I'd have read both columns in the range to one array to cut that down to 1 read operation).
Bartholomeu's code had at least as many reads from the sheet as there are rows to examine, with extra read operations for grabbing data from column A when necessary. Read/write operations to a sheet are relatively time-hungry.
I don't see the point in setting up yet another array (and another loop) when you can do the joining/concatenation within a first and only loop.

[p45cal]

…while I'm at it:

Sub Checker2()
Dim SourceData, missingData, r
SourceData = Range("A2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value
' Iterate through the array
For r = 1 To UBound(SourceData)
  If SourceData(r, 2) = 0 Then
    ' If the data value in the cell is 0, add the value of the cell to the missingdata string
    missingData = missingData & SourceData(r, 1) & ", "
  End If
Next r
' Check the string:
If IsEmpty(missingData) Then                     ' If missingData is empty, show a message box
  MsgBox "No store data is missing."
Else
  MsgBox "Data missing from: " & Left(missingData, Len(missingData) - 2)
End If
End Sub

[arnelgp]

another alternative:

Public Sub Checker2()


    Const SHEET_NAME = "[Stores$]"
    Dim strQuery As String
    Dim cnn As Object       'ADODB.Connection
    Dim rsAdo As Object
    Dim msg As String


    Set cnn = CreateObject("ADODB.Connection")




    cnn.Open _
        "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source='" & ActiveWorkbook.FullName & "';" & _
        "Extended Properties='Excel 12.0;HDR=Yes;ReadOnly=False';"


    strQuery = "SELECT * FROM " & SHEET_NAME & " WHERE ([Entries] = 0) Or ([Entries] Is Null);"


    Set rsAdo = CreateObject("ADODB.Recordset")
    
    With rsAdo
        .Open strQuery, cnn
        If Not (.bof And .EOF) Then
            .movefirst
        End If
        Do Until .EOF
            msg = msg + ", " & ![Store]
            .movenext
        Loop
        .Close
    End With
    Set rsAdo = Nothing
    cnn.Close
    Set cnn = Nothing


    If Len(msg) Then
        msg = Mid$(msg, 2)
        MsgBox "Data missing from: " & msg
    End If
    
End Sub
End Sub

[georgiboy]

This seems to be the best option to me without iterating/ looping in any way, also making use of the Join function to display the message at the end:

Sub EvalFiltVersion()
    Dim fVals As Variant, rng As Range
    
    Set rng = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row)
    fVals = Evaluate("FILTER(" & Application.Index(rng, , 1).Address & "," & Application.Index(rng, , 2).Address & "=0)")
    If IsError(fVals) Then
        MsgBox "No data missing"
    Else
        MsgBox "Data missing from: " & Join(Application.Transpose(fVals), ", ")
    End If
End Sub