Simple macro

[MikeD1224]

I have a spreadsheet that has 1 column of data. It looks as follows...

1314 (sequence #)
070607 (date)
12345678911 (upc)
999 (price)
11987654321 (upc 2)
888 (price 2)

I need the macro to take the sequence # which is always in cell a 1 and fill
to the end in column A. In column B I need it to do the same thing with the
date. Column C needs to have upc, upc2 and so on. Column D would then have
price, price 2 and so on.

In the file the upc is listed first and then below it is its corresponding
price. Then it moves to the next upc and price. Any help would be great.

Mike

 

[JLatham]

If I have understood things properly, this should do the job for you. Use it
on a copy of your workbook/worksheet to make certain it is not wrong - it is
destructive: that is, it erases the UPC/Prices it moves from column A into
columns C and D.

To make it available for use: press [Alt]+[F11] to open the VB Editor. Use
Insert | Module to create a code module and then copy and paste the code
below into the code module. Close the VB Editor, choose the sheet with data
on it and use Tools | Macro | Macros to run the code/macro.

Sub ReOrderData()
Dim seqNum As String
Dim theDate As String
Dim anyUPC As String
Dim anyPrice As Currency
Dim lastRow As Long
Dim activeRow As Long
Dim dataRow As Long
'get and keep the
'position ourselves at known location
Range("A1").Select
'sequence number and date
seqNum = Range("A1").Value
theDate = Range("A2").Value
'find last UPC entry
'and adjust to use as an offset
lastRow = Range("A1").End(xlDown).Row - 2
Application.ScreenUpdating = False ' speed it up
For dataRow = 2 To lastRow Step 2
anyUPC = ActiveCell.Offset(dataRow, 0)
ActiveCell.Offset(dataRow, 0) = "" 'erase it
anyPrice = ActiveCell.Offset(dataRow + 1, 0)
ActiveCell.Offset(dataRow + 1, 0) = "" 'erase it
ActiveCell.Offset(activeRow, 0) = seqNum
ActiveCell.Offset(activeRow, 1) = theDate
ActiveCell.Offset(activeRow, 2) = anyUPC
ActiveCell.Offset(activeRow, 3) = anyPrice
activeRow = activeRow + 1
Next
Application.ScreenUpdating = True
End Sub