Loop through rows in an excel worksheet and copy a range if the cell isn't blank

[FPCJon]

I am new to Excel VBA (using Excel 2007) and have been asked to create a macro to re-order a spreadsheet so that it will load into a new software package.

The workbook is a download from our website cart which shows a list of all our orders.
Here is a snapshot of the workbook (the workbook is called 'Orders.csv' but I can convert to xlsx if needed):

As you can see if the customer purchases more than one product (not qty of a product, a completely different product) it is listed across the row. The first product is starts at column H, the second from column O, the third from column V and so on.
I need the data to be displayed as follows:

So each product is listed below each other and with the same customer details before it. This is so the invoicing software can check each order ID and create an invoice accordingly showing all the different products.

I am good at formulae in Excel but, other than I believe from research that this will need to be a looping macro that checks if a row has data in a cell and then copies ranges accordingly, I have no idea how to actually go about this as I have little to no experience with coding. I have read about looping macros but cannot get my head around how it all fits together.

Ideally, if someone can help, I am looking for a macro with explanations so that I can see how it is put together as I really want to get to grips with this kind of looping macro.

 

[texasalynn]

I'm looking at the way you have the "after macro" results and the subtotal and tax amounts have the same information as the first item. Isn't that incorrect? Wouldn't it have the total amount for that item? For example Paul purchased three items and item 2 and 3 are for more than the shown subtotal.

 

[bibleguy125]

Here is what I have from a previous project, there's lots of notes in the code and will require some alteration to match exactly what you want, but it should form a pretty good basis for what you want to do, if I'm understanding you correctly.

'****This macro is to use on sheets within the same workbook
'****If you want to transfer your data to another workbook you
'****will have to alter the code somewhat, but the idea is the same

Sub copydata()
Dim x As Integer
Dim y As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Worksheets("Ouput sheet") 'whatever you worksheet is
Set ws2 = Worksheets("Orders") 'or whatever your worksheet is called


 'Item 1 - I'm calling the separate sections where each item ordered is in your worksheet Item 1, Item 2
 'this encompasses columns H-N for item 1, etc, etc
 r = 3 'this is the first row where your data will output
 x = 3 'this is the first row where you want to check for data
Do Until ws2.Range("A" & x) = "" 'This will loop until column A is empty, set the column to whatever you want
                                'but it cannot have blanks in it, or it will stop looping. Choose a column that is
                                'always going to have data in it.
                                
    If Not ws2.Range("H" & x).Value = "" Then 'This checks your column H to make sure it's not empty
                                                'If empty, it goes on to the next line, if not it copies the data.
                                                'This column should be something that will have something in it if
                                                'there is a product ordered for Item 1
                                                'i.e. don't choose column J if it will have blanks where there is
                                                'actually an item ordered
                                                
'this section copies the data, the worksheet left of the = sign is the one data will be written to
        ws1.Range("A" & r).Value = ws2.Range("A" & x).Value 'Order Date
        ws1.Range("B" & r).Value = ws2.Range("B" & x).Value 'Order ID
        ws1.Range("C" & r).Value = ws2.Range("C" & x).Value 'Customer
        ws1.Range("D" & r).Value = ws2.Range("D" & x).Value 'Billing Add
        ws1.Range("E" & r).Value = ws2.Range("E" & x).Value 'Subtotal
        ws1.Range("F" & r).Value = ws2.Range("F" & x).Value 'Tax Amount
        ws1.Range("G" & r).Value = ws2.Range("G" & x).Value 'Total Amount
        ws1.Range("H" & r).Value = ws2.Range("H" & x).Value 'Product ID
        ws1.Range("I" & r).Value = ws2.Range("I" & x).Value 'Column J - couldn't read your headings for a few of these
        ws1.Range("J" & r).Value = ws2.Range("J" & x).Value 'Column K
        ws1.Range("K" & r).Value = ws2.Range("K" & x).Value 'L
        ws1.Range("L" & r).Value = ws2.Range("L" & x).Value 'Price
        ws1.Range("M" & r).Value = ws2.Range("M" & x).Value 'Attributes
        
        r = r + 1 'Advances r and x when there is a matching case
        x = x + 1
    Else
        x = x + 1 'Advances only x (to check the next line) when there is not a matching case,
                    'i.e. your output line stays on the next line down from where it last wrote data
                    'while x advances
    End If
Loop 'End of Item 1


'Item 2

 x = 3 'this time we only define x, we want r to stay where it's at so it can continue copying the data into one
        'seamless list
Do Until ws2.Range("A" & x) = "" 'still want this to stay the same
                                
    If Not ws2.Range("O" & x).Value = "" Then 'This one needs to change to match the column in your second Item
                                                
'the ranges on ws1 will stay the same, ws2 ranges pertaining to customer data stay the same, ws2 ranges pertaining
'to specific Item 2 info will change
        ws1.Range("A" & r).Value = ws2.Range("A" & x).Value 'Order Date       *SAME
        ws1.Range("B" & r).Value = ws2.Range("B" & x).Value 'Order ID       *SAME
        ws1.Range("C" & r).Value = ws2.Range("C" & x).Value 'Customer       *SAME
        ws1.Range("D" & r).Value = ws2.Range("D" & x).Value 'Billing Add       *SAME
        ws1.Range("E" & r).Value = ws2.Range("E" & x).Value 'Subtotal       *SAME
        ws1.Range("F" & r).Value = ws2.Range("F" & x).Value 'Tax Amount       *SAME
        ws1.Range("G" & r).Value = ws2.Range("G" & x).Value 'Total Amount       *SAME
        ws1.Range("H" & r).Value = ws2.Range("O" & x).Value 'Product ID       *CHANGED!!!!
        ws1.Range("I" & r).Value = ws2.Range("P" & x).Value 'Column J       *CHANGED!!!!
        ws1.Range("J" & r).Value = ws2.Range("Q" & x).Value 'Column K       *CHANGED!!!!
        ws1.Range("K" & r).Value = ws2.Range("R" & x).Value 'L       *CHANGED!!!!
        ws1.Range("L" & r).Value = ws2.Range("S" & x).Value 'Price       *CHANGED!!!!
        ws1.Range("M" & r).Value = ws2.Range("T" & x).Value 'Attributes       *CHANGED!!!!
        
        r = r + 1 'Advances r and x when there is a matching case
        x = x + 1
    Else
        x = x + 1 'Advances only x (to check the next line) when there is not a matching case,
                    'i.e. your output line stays on the next line down from where it last wrote data
                    'while x advances
    End If
Loop 'End of Item 2
'simply copy Item 2 code and change the appropriate values to match Items 3,4,5,6, etc, etc


'You will get a list of all the info for Item 1, follow by all info for Item 2, etc, etc
'i.e. if Paul orders 2 items, they won't end up right below each other, but his second
'item will end up farther down, but will still be on the list
'If this is not what you want you could sort afterwards or alter the code, but it is a significant alteration

End Sub

 

[FPCJon]

Yes you're quite right, I was concentrating that much on the result of copying the data underneath that I didn't think to alter the subtotal in the example. Although, now I think about it, I don't actually think the invoice software requires this field so I could just delete it, but I will check this. Thanks for spotting my error.

 

[FPCJon]

On the face of it this looks ideal! I will go away and try to work it into my spreadsheet and let you know how I get on. Many thanks, much appreciated.

 

[FPCJon]

Just to let you know that your macro worked perfectly, just what I needed so many thanks again! I just built in a sort function and bobs your uncle!

 

[bibleguy125]

No problem, glad I could help.