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.

31335

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-programming-vba-macros/1419127-iterating-through-a-range-of-cells-with-a-message-at-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