Update to existing Move data macro

K

karl10220

New Member
Joined
Feb 28, 2024
Messages
25
Office Version
  1. 365
Platform
  1. Windows
Hello! I previously came here for help to write a program to move data from one sheet to another with some complex movements. I am hopeful that by pasting the below code I can find help to make some modifications on a new program I am working on.

Previously the cost would take data from 1 cell, duplicate it 8 times, and in the horizontal row grab the data from the various cells and place it vertically (hence copying the part number 8 times and pasting 8 pieces of horizontal data vertically). This is a bit more complex as the information I need is in different columns.

For example,
I used to grab quantities in J, L, N, P, R, T, V, X. Now I need to grab quantities in P,R,T,V,X,Z,AB.
I used to grab corresponding prices in Y, AA, AC, AE, AG, AI, AK, AM. Now I need to grab corresponding prices in O, Q, S, U, W, Y, AA, AC.

I don't see that in my array of how to change it myself or I would have done that.

I'd also like to pull column G and paste it down 8 times because it applies to each iteration of quantity+price. I'd like to paste that in column U on receiving sheet, titled "New BPA".

Lastly, I do have Option Explicit active.

Thank you!

VBA Code: 
Sub New_Part_BPA2_Mod()

    Dim r As Long, q As Integer, lr As Long
    Dim lrData As Long, lcData As Long
    Dim wsData As Worksheet
    Dim wsOutput As Worksheet
    Dim rngData As Range, rngOut As Range
    Dim arrData As Variant, arrOut

    Set wsData = ThisWorkbook.Worksheets("New Parts") ' Change "Data" to the name of your data sheet
    Set wsOutput = ThisWorkbook.Worksheets("New BPA")
   
    With wsData
        lcData = .Cells(1, .Columns.Count).End(xlUp).Column
        lrData = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngData = .Range(.Cells(1, 1), .Cells(lrData, lcData))
        arrData = rngData.Value2
    End With
   
    With wsOutput
        lr = .Columns("E:R").Find("*", , xlValues, , xlByRows, xlPrevious).Row
        If lr = 1 Then lr = 2
        .Range("E2:R" & lr).ClearContents
        Set rngOut = .Cells(2, "E")
    End With
       
    ' Column references based on 1 being Column E
    Dim outSupp As Long, outItem As Long, outPrice As Long, outStore As Long, outQty As Long
    outSupp = 1
    outItem = 8
    outPrice = 10
    outStore = 13
    outQty = 14
   
    ReDim arrOut(1 To lrData * 8, 1 To outQty)
    lr = 0
    For r = 2 To UBound(arrData)                                        ' Loop through all items in data sheet
        For q = 1 To 8                                                  ' Loop through all quantities
            lr = lr + 1                                                 ' Increment row in output sheet
            arrOut(lr, outSupp) = arrData(r, 2)                         ' Supplier
            arrOut(lr, outItem) = arrData(r, 3)                         ' Item
            arrOut(lr, outPrice) = Round(arrData(r, 26 + q * 2), 4)    ' Price
            arrOut(lr, outStore) = arrData(r, 1)                        ' Store
            arrOut(lr, outQty) = arrData(r, 11 + q * 2)                 ' Quantity
        Next q
    Next r
   
    rngOut.Resize(lr, UBound(arrOut, 2)).Value2 = arrOut
End Sub
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
Ooops, you are correct. N is the first quantity... which is always 1. that's why I missed it.
 
Upvote 0
See if this works for you:
VBA Code: 
Sub New_Part_BPA_DiffCols()

    Dim r As Long, q As Integer, lr As Long
    Dim lrData As Long, lcData As Long
    Dim NoOfQtyCols As Long
    Dim wsData As Worksheet
    Dim wsOutput As Worksheet
    Dim rngData As Range, rngOut As Range
    Dim arrData As Variant, arrOut

    Set wsData = ThisWorkbook.Worksheets("New Parts") ' Change "Data" to the name of your data sheet
    Set wsOutput = ThisWorkbook.Worksheets("New BPA")
    
    With wsData
        lcData = .Cells(1, .Columns.Count).End(xlUp).Column
        lrData = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngData = .Range(.Cells(1, 1), .Cells(lrData, lcData))
        arrData = rngData.Value2
        NoOfQtyCols = 8
    End With
    
    With wsOutput
        lr = .Columns("E:R").Find("*", , xlValues, , xlByRows, xlPrevious).Row
        If lr = 1 Then lr = 2
        .Range("E2:R" & lr).ClearContents
        Set rngOut = .Cells(2, "E")
    End With
        
    ' Column references based on 1 being Column E
    Dim outSupp As Long, outItem As Long, outPrice As Long, outStore As Long, outQty As Long
    outSupp = 1
    outItem = 8
    outPrice = 10
    outStore = 13
    outQty = 14
    
    ReDim arrOut(1 To lrData * NoOfQtyCols, 1 To outQty)
    lr = 0
    For r = 2 To UBound(arrData)                                        ' Loop through all items in data sheet
        For q = 1 To NoOfQtyCols                                                  ' Loop through all quantities
            lr = lr + 1                                                 ' Increment row in output sheet
            arrOut(lr, outSupp) = arrData(r, 2)                         ' Supplier
            arrOut(lr, outItem) = arrData(r, 3)                         ' Item
            arrOut(lr, outPrice) = arrData(r, 13 + q * 2)  ' Price
            arrOut(lr, outStore) = arrData(r, 1)                        ' Store
            arrOut(lr, outQty) = arrData(r, 12 + q * 2)                 ' Quantity
        Next q
    Next r
    
    rngOut.Resize(lr, UBound(arrOut, 2)).Value2 = arrOut
End Sub
 
Upvote 0
That appeared to work! Except can I ask for help with a modification. It looks like it's pulling N,P,R,T,V,and X for quantity. Can we shift that over to pull J,L,N,P,R,T,V,X? And price is pulling O,Q,S,U,W,Y and we'd like to pull K,M,O,Q,S,U,W,Y. Basically shift over 2 cells to the left everything.

And can you add a pull column G and multiply it down like we are doing for column A,B,C 8 times per quantity/price above? Input in New BPA sheet in column U.
 
Upvote 0
I have made the code below a lot more wordy to try and make it easier for you in case if you need to change the columns again.
Ideally do a replace of outColU to something more meaningful, if you do a global replace it should appear 4 times.

VBA Code: 
Sub New_Part_BPA_DiffCols()

    Dim r As Long, q As Integer, lr As Long
    Dim lrData As Long, lcData As Long
    Dim NoOfQtyCols As Long
    Dim wsData As Worksheet
    Dim wsOutput As Worksheet
    Dim rngData As Range, rngOut As Range
    Dim arrData As Variant, arrOut
    Dim colQty1st As Long, colOut1st As Long

    Set wsData = ThisWorkbook.Worksheets("New Parts")
    Set wsOutput = ThisWorkbook.Worksheets("New BPA")
    
    With wsData
        lcData = .Cells(1, .Columns.Count).End(xlToLeft).Column
        lrData = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngData = .Range(.Cells(1, 1), .Cells(lrData, lcData))
        arrData = rngData.Value2
        NoOfQtyCols = 8                     ' <--- No of Qty columns (each Qty has an associated Price column)
        
        ' J,L,N,P,R,T,V,X ---> Qty
        ' K,M,O,Q,S,U,W,Y ---> Price
        colQty1st = .Columns("J").Column    ' <---  Start of Qty, Price is offset 1 to the right
  
    End With
    
    With wsOutput
        lr = .Columns("E:R").Find("*", , xlValues, , xlByRows, xlPrevious).Row
        If lr = 1 Then lr = 2
        .Range("E2:R" & lr).ClearContents
        colOut1st = .Columns("E").Column    ' <--- Starting column to be used by array
        Set rngOut = .Cells(2, colOut1st)
    End With
        
    ' Column references based on 1 being Column E - colOut1st is the offset for the starting column in the array
    Dim outSupp As Long, outItem As Long, outPrice As Long, outStore As Long, outQty As Long, outColU As Long
    outSupp = Columns("E").Column - colOut1st + 1
    outItem = Columns("L").Column - colOut1st + 1
    outPrice = Columns("N").Column - colOut1st + 1
    outStore = Columns("Q").Column - colOut1st + 1
    outQty = Columns("R").Column - colOut1st + 1
    outColU = Columns("U").Column - colOut1st + 1                       ' <--- Ideally use an identifiable variable name for this
    
    ReDim arrOut(1 To lrData * NoOfQtyCols, 1 To outColU)
    lr = 0
    For r = 2 To UBound(arrData)                                            ' Loop through all items in data sheet
        For q = 1 To NoOfQtyCols                                            ' Loop through all quantities
            lr = lr + 1                                                     ' Increment row in output sheet
            arrOut(lr, outStore) = arrData(r, 1)                            ' Store    - Column A in Source
            arrOut(lr, outSupp) = arrData(r, 2)                             ' Supplier - Column B in Source
            arrOut(lr, outItem) = arrData(r, 3)                             ' Item     - Column C in Source
            arrOut(lr, outColU) = arrData(r, 7)                             ' Unknown  - Column G in Source
            arrOut(lr, outQty) = arrData(r, colQty1st + (q - 1) * 2)        ' Quantity
            arrOut(lr, outPrice) = arrData(r, colQty1st + 1 + (q - 1) * 2)  ' Price     - Column 1 to the right of Qty - in Source
        Next q
    Next r
    
    rngOut.Resize(lr, UBound(arrOut, 2)).Value2 = arrOut
End Sub
 
Upvote 0
Alex Blakenburg said:
Sub New_Part_BPA_DiffCols() Dim r As Long, q As Integer, lr As Long Dim lrData As Long, lcData As Long Dim NoOfQtyCols As Long Dim wsData As Worksheet Dim wsOutput As Worksheet Dim rngData As Range, rngOut As Range Dim arrData As Variant, arrOut Dim colQty1st As Long, colOut1st As Long Set wsData = ThisWorkbook.Worksheets("New Parts") Set wsOutput = ThisWorkbook.Worksheets("New BPA") With wsData lcData = .Cells(1, .Columns.Count).End(xlToLeft).Column lrData = .Cells(.Rows.Count, "A").End(xlUp).Row Set rngData = .Range(.Cells(1, 1), .Cells(lrData, lcData)) arrData = rngData.Value2 NoOfQtyCols = 8 ' <--- No of Qty columns (each Qty has an associated Price column) ' J,L,N,P,R,T,V,X ---> Qty ' K,M,O,Q,S,U,W,Y ---> Price colQty1st = .Columns("J").Column ' <--- Start of Qty, Price is offset 1 to the right End With With wsOutput lr = .Columns("E:R").Find("*", , xlValues, , xlByRows, xlPrevious).Row If lr = 1 Then lr = 2 .Range("E2:R" & lr).ClearContents colOut1st = .Columns("E").Column ' <--- Starting column to be used by array Set rngOut = .Cells(2, colOut1st) End With ' Column references based on 1 being Column E - colOut1st is the offset for the starting column in the array Dim outSupp As Long, outItem As Long, outPrice As Long, outStore As Long, outQty As Long, outColU As Long outSupp = Columns("E").Column - colOut1st + 1 outItem = Columns("L").Column - colOut1st + 1 outPrice = Columns("N").Column - colOut1st + 1 outStore = Columns("Q").Column - colOut1st + 1 outQty = Columns("R").Column - colOut1st + 1 outColU = Columns("U").Column - colOut1st + 1 ' <--- Ideally use an identifiable variable name for this ReDim arrOut(1 To lrData * NoOfQtyCols, 1 To outColU) lr = 0 For r = 2 To UBound(arrData) ' Loop through all items in data sheet For q = 1 To NoOfQtyCols ' Loop through all quantities lr = lr + 1 ' Increment row in output sheet arrOut(lr, outStore) = arrData(r, 1) ' Store - Column A in Source arrOut(lr, outSupp) = arrData(r, 2) ' Supplier - Column B in Source arrOut(lr, outItem) = arrData(r, 3) ' Item - Column C in Source arrOut(lr, outColU) = arrData(r, 7) ' Unknown - Column G in Source arrOut(lr, outQty) = arrData(r, colQty1st + (q - 1) * 2) ' Quantity arrOut(lr, outPrice) = arrData(r, colQty1st + 1 + (q - 1) * 2) ' Price - Column 1 to the right of Qty - in Source Next q Next r rngOut.Resize(lr, UBound(arrOut, 2)).Value2 = arrOut End Sub
Click to expand...
I tried to edit your code to add another Copy down item from D source to K 'New BPA'. Its giving an error for out of range. I am not sure what I did wrong.

VBA Code: 
Sub New_Part_BPA_DiffCols()

    Dim r As Long, q As Integer, lr As Long
    Dim lrData As Long, lcData As Long
    Dim NoOfQtyCols As Long
    Dim wsData As Worksheet
    Dim wsOutput As Worksheet
    Dim rngData As Range, rngOut As Range
    Dim arrData As Variant, arrOut
    Dim colQty1st As Long, colOut1st As Long

    Set wsData = ThisWorkbook.Worksheets("New Parts")
    Set wsOutput = ThisWorkbook.Worksheets("New BPA")
    
    With wsData
        lcData = .Cells(1, .Columns.Count).End(xlToLeft).Column
        lrData = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngData = .Range(.Cells(1, 1), .Cells(lrData, lcData))
        arrData = rngData.Value2
        NoOfQtyCols = 8                     ' <--- No of Qty columns (each Qty has an associated Price column)
        
        ' J,L,N,P,R,T,V,X ---> Qty
        ' K,M,O,Q,S,U,W,Y ---> Price
        colQty1st = .Columns("J").Column    ' <---  Start of Qty, Price is offset 1 to the right
  
    End With
    
    With wsOutput
        lr = .Columns("E:R").Find("*", , xlValues, , xlByRows, xlPrevious).Row
        If lr = 1 Then lr = 2
        .Range("E2:R" & lr).ClearContents
        colOut1st = .Columns("E").Column    ' <--- Starting column to be used by array
        Set rngOut = .Cells(2, colOut1st)
    End With
        
    ' Column references based on 1 being Column E - colOut1st is the offset for the starting column in the array
    Dim outSupp As Long, outItem As Long, outPrice As Long, outStore As Long, outQty As Long, outColU As Long, outGoods As Long
    outSupp = Columns("E").Column - colOut1st + 1
    outItem = Columns("L").Column - colOut1st + 1
    outPrice = Columns("N").Column - colOut1st + 1
    outStore = Columns("Q").Column - colOut1st + 1
    outQty = Columns("R").Column - colOut1st + 1
    outColU = Columns("U").Column - colOut1st + 1   ' <--- Ideally use an identifiable variable name for this
    outGoods = Columns("K").Column - colOut1st + 1
    
    ReDim arrOut(1 To lrData * NoOfQtyCols, 1 To outColU)
    lr = 0
    For r = 2 To UBound(arrData)                                            ' Loop through all items in data sheet
        For q = 1 To NoOfQtyCols                                            ' Loop through all quantities
            lr = lr + 1                                                     ' Increment row in output sheet
            arrOut(lr, outStore) = arrData(r, 1)                            ' Store    - Column A in Source
            arrOut(lr, outSupp) = arrData(r, 2)                             ' Supplier - Column B in Source
            arrOut(lr, outItem) = arrData(r, 3)                             ' Item     - Column C in Source
            arrOut(lr, outGoods) = arrData(r, 4)                            ' Unknown  - Column D in Source
            arrOut(lr, outColU) = arrData(r, 7)                             ' Unknown  - Column G in Source
            arrOut(lr, outQty) = arrData(r, colQty1st + (q - 1) * 2)        ' Quantity
            arrOut(lr, outPrice) = arrData(r, colQty1st + 1 + (q - 1) * 2)  ' Price     - Column 1 to the right of Qty - in Source
        Next q
    Next r
    
    rngOut.Resize(lr, UBound(arrOut, 2)).Value2 = arrOut
End Sub
 
Upvote 0
Did you run exactly what you posted ?
That looks fine to me and worked on my machine.
Which line did it error out on ?
PS: I am using the outColU in the Redim statement, so it will be more intuitive if you put your Col K line in the order in that list.

20240319 VBA Copy Paste update of 20240305 karl10220 v02.xlsm
EFGHIJKLMNOPQRSTU
1SupplierGoodsItemPriceStoreQtyUnknown
2Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 11Row 2~Col 1Row 2~Col 10Row 2~Col 7
3Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 13Row 2~Col 1Row 2~Col 12Row 2~Col 7
4Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 15Row 2~Col 1Row 2~Col 14Row 2~Col 7
5Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 17Row 2~Col 1Row 2~Col 16Row 2~Col 7
6Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 19Row 2~Col 1Row 2~Col 18Row 2~Col 7
7Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 21Row 2~Col 1Row 2~Col 20Row 2~Col 7
8Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 23Row 2~Col 1Row 2~Col 22Row 2~Col 7
9Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 25Row 2~Col 1Row 2~Col 24Row 2~Col 7
10Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 11Row 3~Col 1Row 3~Col 10Row 3~Col 7
11Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 13Row 3~Col 1Row 3~Col 12Row 3~Col 7
12Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 15Row 3~Col 1Row 3~Col 14Row 3~Col 7
13Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 17Row 3~Col 1Row 3~Col 16Row 3~Col 7
14Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 19Row 3~Col 1Row 3~Col 18Row 3~Col 7
15Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 21Row 3~Col 1Row 3~Col 20Row 3~Col 7
16Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 23Row 3~Col 1Row 3~Col 22Row 3~Col 7
17Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 25Row 3~Col 1Row 3~Col 24Row 3~Col 7
New BPA
 
Upvote 0
Alex Blakenburg said:
Did you run exactly what you posted ?
That looks fine to me and worked on my machine.
Which line did it error out on ?
PS: I am using the outColU in the Redim statement, so it will be more intuitive if you put your Col K line in the order in that list.

20240319 VBA Copy Paste update of 20240305 karl10220 v02.xlsm
EFGHIJKLMNOPQRSTU
1SupplierGoodsItemPriceStoreQtyUnknown
2Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 11Row 2~Col 1Row 2~Col 10Row 2~Col 7
3Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 13Row 2~Col 1Row 2~Col 12Row 2~Col 7
4Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 15Row 2~Col 1Row 2~Col 14Row 2~Col 7
5Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 17Row 2~Col 1Row 2~Col 16Row 2~Col 7
6Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 19Row 2~Col 1Row 2~Col 18Row 2~Col 7
7Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 21Row 2~Col 1Row 2~Col 20Row 2~Col 7
8Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 23Row 2~Col 1Row 2~Col 22Row 2~Col 7
9Row 2~Col 2Row 2~Col 4Row 2~Col 3Row 2~Col 25Row 2~Col 1Row 2~Col 24Row 2~Col 7
10Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 11Row 3~Col 1Row 3~Col 10Row 3~Col 7
11Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 13Row 3~Col 1Row 3~Col 12Row 3~Col 7
12Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 15Row 3~Col 1Row 3~Col 14Row 3~Col 7
13Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 17Row 3~Col 1Row 3~Col 16Row 3~Col 7
14Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 19Row 3~Col 1Row 3~Col 18Row 3~Col 7
15Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 21Row 3~Col 1Row 3~Col 20Row 3~Col 7
16Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 23Row 3~Col 1Row 3~Col 22Row 3~Col 7
17Row 3~Col 2Row 3~Col 4Row 3~Col 3Row 3~Col 25Row 3~Col 1Row 3~Col 24Row 3~Col 7
New BPA
Click to expand...
I ran this code exactly... which should match what I posted before. It is having the error on this statement: arrOut(lr, outGoods) = arrData(r, 4) ' Unknown - Column D in Source

VBA Code: 
Sub New_Part_BPA_DiffCols()

    Dim r As Long, q As Integer, lr As Long
    Dim lrData As Long, lcData As Long
    Dim NoOfQtyCols As Long
    Dim wsData As Worksheet
    Dim wsOutput As Worksheet
    Dim rngData As Range, rngOut As Range
    Dim arrData As Variant, arrOut
    Dim colQty1st As Long, colOut1st As Long

    Set wsData = ThisWorkbook.Worksheets("New Parts")
    Set wsOutput = ThisWorkbook.Worksheets("New BPA")
    
    With wsData
        lcData = .Cells(1, .Columns.Count).End(xlToLeft).Column
        lrData = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngData = .Range(.Cells(1, 1), .Cells(lrData, lcData))
        arrData = rngData.Value2
        NoOfQtyCols = 8                     ' <--- No of Qty columns (each Qty has an associated Price column)
        
        ' J,L,N,P,R,T,V,X ---> Qty
        ' K,M,O,Q,S,U,W,Y ---> Price
        colQty1st = .Columns("J").Column    ' <---  Start of Qty, Price is offset 1 to the right
  
    End With
    
    With wsOutput
        lr = .Columns("E:R").Find("*", , xlValues, , xlByRows, xlPrevious).Row
        If lr = 1 Then lr = 2
        .Range("E2:R" & lr).ClearContents
        colOut1st = .Columns("E").Column    ' <--- Starting column to be used by array
        Set rngOut = .Cells(2, colOut1st)
    End With
        
    ' Column references based on 1 being Column E - colOut1st is the offset for the starting column in the array
    Dim outSupp As Long, outItem As Long, outPrice As Long, outStore As Long, outQty As Long, outColU As Long, outGoods As Long
    outSupp = Columns("E").Column - colOut1st + 1
    outGoods = Columns("K").Column - colOut1st + 1
    outItem = Columns("L").Column - colOut1st + 1
    outPrice = Columns("N").Column - colOut1st + 1
    outStore = Columns("Q").Column - colOut1st + 1
    outQty = Columns("R").Column - colOut1st + 1
    outColU = Columns("U").Column - colOut1st + 1   ' <--- Ideally use an identifiable variable name for this
    
    ReDim arrOut(1 To lrData * NoOfQtyCols, 1 To outColU)
    lr = 0
    For r = 2 To UBound(arrData)                                            ' Loop through all items in data sheet
        For q = 1 To NoOfQtyCols                                            ' Loop through all quantities
            lr = lr + 1                                                     ' Increment row in output sheet
            arrOut(lr, outStore) = arrData(r, 1)                            ' Store    - Column A in Source
            arrOut(lr, outSupp) = arrData(r, 2)                             ' Supplier - Column B in Source
            arrOut(lr, outItem) = arrData(r, 3)                             ' Item     - Column C in Source
            arrOut(lr, outGoods) = arrData(r, 4)                            ' Unknown  - Column D in Source
            arrOut(lr, outColU) = arrData(r, 7)                             ' Unknown  - Column G in Source
            arrOut(lr, outQty) = arrData(r, colQty1st + (q - 1) * 2)        ' Quantity
            arrOut(lr, outPrice) = arrData(r, colQty1st + 1 + (q - 1) * 2)  ' Price     - Column 1 to the right of Qty - in Source
        Next q
    Next r
    
    rngOut.Resize(lr, UBound(arrOut, 2)).Value2 = arrOut
End Sub
 
Upvote 0
Solution
That's just bizarre the code runs perfectly for me.
When it errors out can you hover of outGoods and tell me what value it comes up with ?
(do lr and r as well but if they were the problem it shouldn't have gotten to that line.)

The only other thing is if you could share the workbook via a sharing platform (Dropbox, Google drive etc) with permission to anyone with the link.
Just make sure that the issue still exists in your sample workbook.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
My VBA is only copying the last row of data instead of all the rows
2 3
Replies
24
Views
542
Alex Blakenburg
A
W
  • Question
UPDATING EXCEL SHEET BASED ON CELL DATA
Replies
1
Views
373
wndncg
W
W
  • Solved
Macro works when ran on sheet1 but not when ran from sheet2
Replies
2
Views
432
Welearnaswego
W
K
  • Solved
save as desktop & save as macro free workbook
2
Replies
11
Views
790
John_w
J
P
  • Question
Need to assign a progress bar while the macro is running.
Replies
7
Views
504
GWteB
GWteB

Forum statistics

Threads
1,215,071
Messages
6,122,963
Members
449,094
Latest member
Anshu121

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top