Previously working very complex VBA now stopped

[karl10220]

Hello! I don't know what happened, but my macro has stopped working! It just isn't putting data in the right spots, so I will again explain what I am hoping you can help identify the issue for.

I have a large table of data with a lot of data. It is in horizontal format today and it needs to be changed to somewhat vertical formatting. Column A includes a stored figure that needs to be pasted 8 times down (output file column L), as well as the figures from volumes N, P, R, T, V, X, Z, AB (Output file column R) down and values from O, Q, S, U, W, Y, AA, AC (output file column N) beside the value from column A. I also need the value from Column C stored and placed 8 times down in the output file (column Q) , and the value from column D stored and placed 8 times down in the output file (column E). Lastly, I need the value in column L stored and placed 8 times down in the output file (column U). I am also wondering if I could just get a word pasted in every row of column K ("Goods") and M ("Each").

I have gotten quite rusty and I am not sure what happened here.

A "Nice to have" would be that the figure in column O-AC and output into column N could be rounded to only 3 decimal points. Not as a formatting thing, but using a 'round' function so when they are later pasted those numbers don't come back, just stuck at 3 decimal points.

Thanks in advance!

Sub Corrgulator_to_BPA()

    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("Corrgulator")
    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

 

[Alex Blakenburg]

my macro has stopped working! It just isn't putting data in the right spots

That is because your source data appears to be in different columns now and your output columns also seem to have moved around.
Previously you had 5 columns repeating Store, Supplier, Item, Goods & Column U (you didn't get back to me on a request for the name of that column).
You now only have 4 columns repeating, is that correct or did you miss one ?
You have 2 columns that repeat Qty & Price but only mention one output being Column N, what is other column for the ouptut and which goes to which ?
You have asked for column O-AC to be 3 decimal places but your value columns start at N, I assume it should say N-AC ? Also you want both Qty and Price to 3 decimals correct ?

Please show a sample of your input sheet including row and column references and the column headings.
Also a sample of the output sheet including row and column references and what should be mapped to what column

 

[karl10220]

Attached is the file with information in current state:

And below is the output file in how we would want it. Note that the current state file could have hundreds of line items.

 

[Alex Blakenburg]

See if this works for you:

Sub Corrgulator_to_BPA_OP_mod()

    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("Corrgulator")
    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)
       
        ' N,P,R,T,V,X,Z,AB ---> Qty
        ' O,Q,S,U,W,Y,AA,AC ---> Price
        colQty1st = .Columns("N").Column    ' <---  Start of Qty, Price is offset 1 to the right
 
    End With
   
    With wsOutput
        lr = .Columns("E:U").Find("*", , xlValues, , xlByRows, xlPrevious).Row
        If lr = 1 Then lr = 2
        .Range("E2:U" & 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, outOnSite As Long
    Dim outGoods As Long, outUoM As Long
    outSupp = Columns("E").Column - colOut1st + 1
    outGoods = Columns("K").Column - colOut1st + 1
    outItem = Columns("L").Column - colOut1st + 1           ' Part Item (Part Number)
    outUoM = Columns("M").Column - colOut1st + 1
    outPrice = Columns("N").Column - colOut1st + 1
    outStore = Columns("Q").Column - colOut1st + 1          ' Ship to
    outQty = Columns("R").Column - colOut1st + 1
    outOnSite = Columns("U").Column - colOut1st + 1         ' Stocked on site? Yes/No
   
    ReDim arrOut(1 To lrData * NoOfQtyCols, 1 To outOnSite)
    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, 3)                            ' Store    - Column C in Source
            arrOut(lr, outSupp) = arrData(r, 4)                             ' Supplier - Column D in Source
            arrOut(lr, outItem) = arrData(r, 1)                             ' Item     - Column A in Source (Part Item/Part Number)
            arrOut(lr, outOnSite) = arrData(r, 12)                          ' Stocked on Site  - Column L in Source
            arrOut(lr, outGoods) = "Goods"                                  ' Goods    - Hard Coded
            arrOut(lr, outUoM) = "Each"                                     ' Each    - Hard Coded
            
            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
            ' Apply Rounding
            With Application
                arrOut(lr, outPrice) = .IfError(.Round(arrOut(lr, outPrice), 3), 0)
            End With
        Next q
    Next r
   
    rngOut.Resize(lr, UBound(arrOut, 2)).Value2 = arrOut
End Sub

 

[karl10220]

See if this works for you:

Sub Corrgulator_to_BPA_OP_mod()

    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("Corrgulator")
    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)
      
        ' N,P,R,T,V,X,Z,AB ---> Qty
        ' O,Q,S,U,W,Y,AA,AC ---> Price
        colQty1st = .Columns("N").Column    ' <---  Start of Qty, Price is offset 1 to the right
 
    End With
  
    With wsOutput
        lr = .Columns("E:U").Find("*", , xlValues, , xlByRows, xlPrevious).Row
        If lr = 1 Then lr = 2
        .Range("E2:U" & 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, outOnSite As Long
    Dim outGoods As Long, outUoM As Long
    outSupp = Columns("E").Column - colOut1st + 1
    outGoods = Columns("K").Column - colOut1st + 1
    outItem = Columns("L").Column - colOut1st + 1           ' Part Item (Part Number)
    outUoM = Columns("M").Column - colOut1st + 1
    outPrice = Columns("N").Column - colOut1st + 1
    outStore = Columns("Q").Column - colOut1st + 1          ' Ship to
    outQty = Columns("R").Column - colOut1st + 1
    outOnSite = Columns("U").Column - colOut1st + 1         ' Stocked on site? Yes/No
  
    ReDim arrOut(1 To lrData * NoOfQtyCols, 1 To outOnSite)
    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, 3)                            ' Store    - Column C in Source
            arrOut(lr, outSupp) = arrData(r, 4)                             ' Supplier - Column D in Source
            arrOut(lr, outItem) = arrData(r, 1)                             ' Item     - Column A in Source (Part Item/Part Number)
            arrOut(lr, outOnSite) = arrData(r, 12)                          ' Stocked on Site  - Column L in Source
            arrOut(lr, outGoods) = "Goods"                                  ' Goods    - Hard Coded
            arrOut(lr, outUoM) = "Each"                                     ' Each    - Hard Coded
           
            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
            ' Apply Rounding
            With Application
                arrOut(lr, outPrice) = .IfError(.Round(arrOut(lr, outPrice), 3), 0)
            End With
        Next q
    Next r
  
    rngOut.Resize(lr, UBound(arrOut, 2)).Value2 = arrOut
End Sub

This works beautifully! I can't express my thanks enough! There is one minor revision that would make it nearly perfect. Could we cap the output file N (Price) at 3 decimal points? There are some at 4 and I can correct after with a Round function but wasn't sure if the Macro could do that automatically?


Another question I had was if a cell in the data file was colored, could the macro bring it out? For example, if the 'Stocked' column said Yes, then a price is selected each time regardless of having the various pricing brackets listed. Normally there are 6 price brackets, but if an item is stocked, there is only one price bracket and that is determined only by the cell being 'filled' with a color. Could the macro only spit out the colored cell figure on price, while the quantity for this would remain 1 (meaning no matter the quantity, the price is the same), etc.? I am not sure how advanced something like this can get. If not, that will be manual and based on the work saved on the other, definitely manageable.

 

[Alex Blakenburg]

Could we cap the output file N (Price) at 3 decimal points? There are some at 4 and I can correct after with a Round function but wasn't sure if the Macro could do that automatically?

Can show me a before and after of this happening ?
I need Row & Column References to be visible as well as the Cell contents in the edit box.
Because this line was supposed to do exactly that and is using the worksheet round function.
arrOut(lr, outPrice) = .IfError(.Round(arrOut(lr, outPrice), 3), 0)

Another question I had was if a cell in the data file was colored, could the macro bring it out?

I am currently using and array to process the data in memory which is what makes it really fast.
The array doesn't have access to colours and that would involve a substantial change to the code and make is much slower.
If you don't want to repeat rows if the Stock Price is Yes, then the array has that information and we could make a change for that although I suspect that would mean you also want the quantity summed for that line.
Again show me before and after images of what you want with Row & Column references.

 

[karl10220]

Can show me a before and after of this happening ?
I need Row & Column References to be visible as well as the Cell contents in the edit box.
Because this line was supposed to do exactly that and is using the worksheet round function.
arrOut(lr, outPrice) = .IfError(.Round(arrOut(lr, outPrice), 3), 0)


I am currently using and array to process the data in memory which is what makes it really fast.
The array doesn't have access to colours and that would involve a substantial change to the code and make is much slower.
If you don't want to repeat rows if the Stock Price is Yes, then the array has that information and we could make a change for that although I suspect that would mean you also want the quantity summed for that line.
Again show me before and after images of what you want with Row & Column references.

It was showing a 4th decimal but upon closer review it was just an extra 0. Your formula is working great! I can mark that as the solution if you'd like since the original issue was solved. This color issue is a new unique one. Imagine from our initial review that cells L3 and L4 are changed to Yes (like L11). If that's true, then cells S3 and W4 are highlighted as well. In those instances instead of showing quantities and prices for 1-44, 45-110, etc. we would only want to show quantity 1 and the highlighted price. The rationale behind is if we are asking someone to hold inventory, they are buying in quantities that are much larger, they are getting a price break, and therefore they are able to pass that flat pricing on to us for a much lower price. So on the other lines, as we order greater or smaller quantities, the price goes up or down, but when it's stocked then if we order 1 carton or 2000 cartons of that product, the price will be the same and thus in our output file we wouldn't repeat like you said. We would take the figure from N3 or N4 and the price (highlighted) from S3 and W4, respectively.

Does that make sense or just complicate things beyond any ability to function?

 

[Alex Blakenburg]

I think you are right. Close this thread and create a new one for you colour requirement.
In the new thread advise:
• If it is possible to have an additional column with the In Stock Price rather than relying on colours ?
• If not are you saying that 1 of the Price columns (out of the 8) will have a colour and that is the one to be used to create a single line instead of the normal 8 lines ?