Weird dimensions with an array macro

Question

so I wrote this code that's supposed to result in an two arrays that should start from cells I4 and O4, respectively.

Option Explicit

Sub QuartTransfer()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim cws As Worksheet: Set cws = wb.Worksheets("All Transaction Data")
    Dim dws As Worksheet: Set dws = wb.Worksheets("Quarterly Transfers")
    
    Dim srg As Range: Set srg = cws.Range("B2:V" & dws.Range("C1").Value)
    Dim Data As Variant: Data = srg.Value
    Dim Sale(), Pur() As Variant
    
    Application.ScreenUpdating = False
    
    Dim i, k, p As Long
    For i = 1 To UBound(Data, 1)
        If Data(i, 9) = "Intra L.E. Sale" Or Data(i, 9) = "Tax Free Exchange - Dis" Or Data(i, 9) = "InterCompany Sale IP2" Then
            k = k + 1
            ReDim Preserve Sale(6, 1 To k)
            Sale(1, k) = Data(i, 5)
            Sale(3, k) = Data(i, 1)
            Sale(4, k) = Data(i, 11)
            Sale(5, k) = Data(i, 13)
            Sale(6, k) = Data(i, 8)
        ElseIf Data(i, 9) = "Intra L.E. Purchase" Or Data(i, 9) = "Tax Free Exchange - Acq" Or Data(i, 9) = "InterCompany Pur IP2" Then
            p = p + 1
            ReDim Preserve Pur(7, 1 To p)
            Pur(1, p) = Data(i, 9)
            Pur(2, p) = Data(i, 5)
            Pur(4, p) = Data(i, 1)
            Pur(5, p) = Data(i, 11)
            Pur(6, p) = Data(i, 13)
            Pur(7, p) = Data(i, 8)
        End If
    Next i
    
    dws.Range("I4").Resize(k, 6).Value = Application.WorksheetFunction.Transpose(Sale)
    dws.Range("O4").Resize(p, 7).Value = Application.WorksheetFunction.Transpose(Pur)
    
    Application.ScreenUpdating = True

End Sub

The problem is that the results are shifted one column to the right with the last column of data missing. Is there something I'm missing here? Pls help!

Scott Craner · Accepted Answer · 2021-04-01 19:52:00Z

Using Redim Preserve in the Loop is very costly and time consuming. There is no reason for it. You already limit the size or the output.

Also your problem is that you assume the array starts at 1 but it starts at 0. Which is why you columns are off.

Create the two arrays the same number of rows as the input and just post where they are full. The counters k and p will track that.

Also Dim i, k, p As Long only declare k as a Long the others are Variant

Option Explicit

Sub QuartTransfer()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim cws As Worksheet: Set cws = wb.Worksheets("All Transaction Data")
    Dim dws As Worksheet: Set dws = wb.Worksheets("Quarterly Transfers")
    
    Dim srg As Range: Set srg = cws.Range("B2:V" & dws.Range("C1").Value)
    Dim Data() As Variant: Data = srg.Value
    Dim Sale() As Variant
    ReDim Sale(1 To UBound(Data, 1), 1 To 6) As Variant
    
    Dim Pur() As Variant
    ReDim Pur(1 To UBound(Data, 1), 1 To 7) As Variant
    
    
    Dim i As Long, k As Long, p As Long
    For i = 1 To UBound(Data, 1)
        If Data(i, 9) = "Intra L.E. Sale" Or Data(i, 9) = "Tax Free Exchange - Dis" Or Data(i, 9) = "InterCompany Sale IP2" Then
            k = k + 1
            Sale(k, 1) = Data(i, 5)
            Sale(k, 3) = Data(i, 1)
            Sale(k, 4) = Data(i, 11)
            Sale(k, 5) = Data(i, 13)
            Sale(k, 6) = Data(i, 8)
        ElseIf Data(i, 9) = "Intra L.E. Purchase" Or Data(i, 9) = "Tax Free Exchange - Acq" Or Data(i, 9) = "InterCompany Pur IP2" Then
            p = p + 1
            Pur(p, 1) = Data(i, 9)
            Pur(p, 2) = Data(i, 5)
            Pur(p, 4) = Data(i, 1)
            Pur(p, 5) = Data(i, 11)
            Pur(p, 6) = Data(i, 13)
            Pur(p, 7) = Data(i, 8)
        End If
    Next i
    
    dws.Range("I4").Resize(k, 6).Value = Sale
    dws.Range("O4").Resize(p, 7).Value = Pur
    


End Sub

Collectives™ on Stack Overflow

Weird dimensions with an array macro

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related