Why is my array returning empty? And how do I ensure it copies the data into my third selection-CodePudding

After countless efforts to keep the array "newvarray" within range, I am now running into a result of an empty array from a 278 line column. I believe this is also the root cause of my endgame function not executing (pasting unmatched values into the rolls sheet)?

Clarification: the actualy empty cells report on locals as "Empty", the columns with string report as " "" "

Dim oldsht As Worksheet
Dim newsht As Worksheet
Dim rollsht As Worksheet

Dim a As Integer
Dim b As Integer
Dim c As Integer

Set oldsht = ThisWorkbook.Sheets("Insert Yesterday's Report Here")
Set newsht = ThisWorkbook.Sheets("Insert Today's Report Here")
Set rollsht = ThisWorkbook.Sheets("Rolls")

Dim OldVArray(), NewVArray(), RollArray() As String

ReDim Preserve OldVArray(1 To oldsht.Range("a" & Rows.Count).End(xlUp).Row - 1, 5 To 5)
ReDim Preserve NewVArray(2 To newsht.Range("a" & Rows.Count).End(xlUp).Row, 5 To 5)
ReDim Preserve RollArray(1 To rollsht.Range("a" & Rows.Count).End(xlUp).Row - 1, 3 To 3)

For a = 2 To oldsht.Range("E" & Rows.Count).End(xlUp).Row
    OldVArray(a, 5) = oldsht.Cells(a, 5)
Next a

For b = 2 To newsht.Range("E" & Rows.Count).End(xlUp).Row
    NewVArray(b, 5) = newsht.Cells(b, 5)
Next b

For c = 2 To rollsht.Range("C" & Rows.Count).End(xlUp).Row
    RollArray(c, 3) = rollsht.Cells(c, 3)
Next c

Dim Voyage As String
For a = 2 To UBound(OldVArray)
    Voyage = OldVArray(a, 5)
    
    For b = 2 To UBound(NewVArray)
    voyage2 = NewVArray(b, 5)
        If voyage2 <> Voyage Then
            If voyage2 <> "" Then
                For Each cell In NewVArray
                voyage2 = rollsheet.Range("C:C")               
                Next
            End If
        End If
    Next
Next

Here are snips of sample idea, highlighted are the rows that need to be found, and the voyage that changed is in orange. Third on Rolls would be the output of the macro.

Oldsheet:

Newsheet:

Rolls:

CodePudding user response：

Untested, but this is how I'd do it. Just going from your screenshots. If your actual data looks different then you will need to make some adjustments.

Sub test()
    Dim wb As Workbook, oldsht As Worksheet, newsht As Worksheet, rollsht As Worksheet
    Dim c As Range, id, col, cDest As Range, copied As Boolean, m
    
    Set wb = ThisWorkbook
    Set oldsht = wb.Sheets("Insert Yesterday's Report Here")
    Set newsht = wb.Sheets("Insert Today's Report Here")
    Set rollsht = wb.Sheets("Rolls")
    'next empty row on Rolls sheet
    Set cDest = rollsht.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    'loop colA on new sheet
    For Each c In newsht.Range("A2:A" & newsht.Cells(Rows.Count, "A").End(xlUp).row).Cells
        id = c.Value         'identifier from Col A
        If Len(id) > 0 Then
            m = Application.Match(id, oldsht.Columns("A"), 0) 'check for exact match on old sheet
            If Not IsError(m) Then
                'got a match: check for updates in cols B to C
                copied = False
                For col = 2 To 3
                    If c.EntireRow.Cells(col).Value <> oldsht.Cells(m, col).Value Then
                        If Not copied Then 'already copied this row?
                            cDest.Resize(1, 3).Value = c.Resize(1, 3).Value 'copy changed row
                            Set cDest = cDest.Offset(1) ' next empy row
                            copied = True
                        End If
                        cDest.EntireRow.Cells(col).Interior.Color = vbRed 'flag updated value
                    End If
                Next col
            Else
                cDest.Resize(1, 3).Value = c.Resize(1, 3).Value 'copy new row
                Set cDest = cDest.Offset(1) ' next empy row
            End If
        End If
    Next c
End Sub