Comparing two arrays in VBA and adding rows

Question

since I'm fairly new to VBA I need a help with part of my code, that is supposed to compare two arrays that are sorted ascendingly and if a value in either of the arrays is missing then it's supposed to add row to appropriate table and fill in missing value with value zero to the cell next to it. This is what I've got so far:

With ActiveSheet
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

For I = 3 To LastRow
    If Cells(I, 1) > Cells(I, 6) Then
        LastRow = LastRow + 1
        With Range("A" & I & ":C" & I)
            .Select
            .Insert Shift:=xlDown
        End With
        Range("A" & I) = Cells(I, 6)
        Cells(I, 2).Value = 0
    ElseIf Cells(I, 1).Value < Cells(I, 6).Value Then
        With Range("F" & I & ":H" & I)
            .Select
            .Insert Shift:=xlDown
        End With
        Range("F" & I) = Cells(I, 1)
        Cells(I, 7).Value = 0
    Else
    End If
 Next i

The issue with this code, besides it's ineffectiveness (which is not the issue since both arrays are very small) is that LastRow: a) changes with each row that is added, b) only counts LastRow in array1 so if array2 is bigger it doesn't go all the way down, c) if cell is empty it seems to add row with empty cell to appropriate array even if I add

If Not IsEmpty (Cells(i, 1)) And IsEmpty(Cells(i, 6)) Then 'next i

I know the solution is probably lies in defining both arrays and using LBound to Ubound however I couldn't get my head around it. Thanks a lot for help!

EDIT: The last row thing seems to be fixed now, however I'm still unable to somehow skip blank cells and cell in the last that has "Grand Total" text inside and thus is not sorted unlike rest of the range. Anyone has any ideas how to bypass this? This is what the code looks like now:

CurrentRow = 3
Do While CurrentRow <= LastRow
    If Cells(CurrentRow, 1) > Cells(CurrentRow, 6) Then
        If Not Cells(CurrentRow, 6).Value = "Grand Total" Or IsEmpty(Cells(CurrentRow, 6).Value) Then
            With Range("A" & CurrentRow & ":C" & CurrentRow)
                .Select
                .Insert Shift:=xlDown
            End With
            Range("A" & CurrentRow) = Cells(CurrentRow, 6)
            Cells(CurrentRow, 2).Value = 0
        End If
    ElseIf Cells(CurrentRow, 6) > Cells(CurrentRow, 1) Then
        If Not Cells(CurrentRow, 1).Value = "Grand Total" Or IsEmpty(Cells(CurrentRow, 1).Value) Then
            With Range("F" & CurrentRow & ":H" & CurrentRow)
                .Select
                .Insert Shift:=xlDown
            End With
            Range("F" & CurrentRow) = Cells(CurrentRow, 1)
            Cells(CurrentRow, 7).Value = 0
        End If
    Else
    End If
    With ActiveSheet
        LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
    End With
    CurrentRow = CurrentRow + 1
    Debug.Print CurrentRow
Loop

EDIT 2: I figured it out at last! I just added another condition to add row to opposite table if it finds value "Grand Total". No need to bother with empty cells!

CurrentRow = 3
Do While CurrentRow <= LastRow
    If Cells(CurrentRow, 1) > Cells(CurrentRow, 6) Then
        If Cells(CurrentRow, 6).Value = "Grand Total" Then
            With Range("F" & CurrentRow & ":H" & CurrentRow)
                .Select
                .Insert Shift:=xlDown
            End With
            Range("F" & CurrentRow) = Cells(CurrentRow, 1)
            Cells(CurrentRow, 7).Value = 0
        Else
            With Range("A" & CurrentRow & ":C" & CurrentRow)
                .Select
                .Insert Shift:=xlDown
            End With
            Range("A" & CurrentRow) = Cells(CurrentRow, 6)
            Cells(CurrentRow, 2).Value = 0
        End If
    ElseIf Cells(CurrentRow, 6) > Cells(CurrentRow, 1) Then
        If Cells(CurrentRow, 1).Value = "Grand Total" Then
            With Range("A" & CurrentRow & ":C" & CurrentRow)
                .Select
                .Insert Shift:=xlDown
            End With
            Range("A" & CurrentRow) = Cells(CurrentRow, 6)
            Cells(CurrentRow, 2).Value = 0
        Else
            With Range("F" & CurrentRow & ":H" & CurrentRow)
                .Select
                .Insert Shift:=xlDown
            End With
            Range("F" & CurrentRow) = Cells(CurrentRow, 1)
            Cells(CurrentRow, 7).Value = 0
        End If
    Else
    End If
    With ActiveSheet
        LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
    End With
    CurrentRow = CurrentRow + 1
    Debug.Print CurrentRow
Loop

And by arrays, you mean excel ranges? Because I'm unable to locate any VBA arrays in this code — EngJon
– EngJon, Commented Aug 13, 2015 at 9:37
For Lastrow, you can use another approach: A summary of different LastRow attempts can be found here I'd suggest trying the used range one after an iteration — EngJon
– EngJon, Commented Aug 13, 2015 at 9:45
@EngJon Yes, I meant excel ranges, sorry for the confusion. Also thanks for the answer. I'm gonna check that out. — Kotty
– Kotty, Commented Aug 13, 2015 at 11:25

tea_pea · Accepted Answer · 2015-08-13 10:15:05Z

a nice tidy question for a change! Here are my thoughts on the first two parts:

a) with a for loop, the initial conditions (Lastrow in this case) are only read when initiating the loop, therefore if you change Lastrow during the loop, the loop will still run only to the original value.

to get around this you could restructure it as a do while loop. using a generic example:

Sub loop_for()

    Dim intLoop As Integer
    Dim intEnd As Integer

    intEnd = 3

    For intLoop = 1 To intEnd 'this is fixed as soon as is triggered
        Debug.Print intLoop
        If intLoop = 2 Then intEnd = 4 'this has no effect on loop
    Next intLoop

'output is 1,2,3
End Sub

VS

Sub loop_while()

    Dim intLoop As Integer
    Dim intEnd As Integer

    intLoop = 1
    intEnd = 3

    Do While intLoop <= intEnd

        Debug.Print intLoop
        intLoop = intLoop + 1

        If intLoop = 2 Then intEnd = 4

    Loop

'output is 1,2,3,4
End Sub

b) why not just evaluate both and pick the larger of the two?

Sub lastrow()

    Dim lastrow As Long
    Dim lastrow1 As Long
    Dim lastrow2 As Long

    lastrow1 = ActiveSheet.Cells(.Rows.Count, "A").End(xlUp).Row
    lastrow2 = ActiveSheet.Cells(.Rows.Count, "F").End(xlUp).Row
    lastrow = Application.Max(lastrow1, lastrow2)

End Sub

c) ran out of steam here, hopefully someone else can help.

Thanks, your comment was very helpful. I've taken your advice and replaced For...Next loop with Do While loop.

Collectives™ on Stack Overflow

Comparing two arrays in VBA and adding rows

1 Answer 1

1 Comment

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Related