Macro to extract certain data from a source and reformat it

Hi,

Got a bit of a tricky one.

I've got a list of data that I need to change into a table in a different format.

If you look at the attached spreadsheet - I need to look at the order numbers of each row and create one "POH" line per order number and multiple "POL" lines per order number (based on how many rows there are per "POL".

So if we look at the first 2 rows of order number 115074 this would translate to one "POH" line on the output file and two "POL" line. 117373 would translate to one "POH" line and three "POL" lines. Each line extracting data from the columns noted and placing it within the table.

Hope this makes sense as it's pretty awkward to explain.

Any help would be reeaaaly appreciated as I've struggled with this for a while.

Hi,

the second option so 115074's POH line followed by 115074's POL lines followed by 11737's POH line followed by 11737's POL line (which I think makes it more difficult :S)

I only wish to transfer that data that I've mentioned and in those specific columns.

Thanks for taking the time to look at this

Sorry, I just noticed I had the order date targeted incorrectly. Fixed:

Sub FillOutput()
Dim OutputRow As Long
Dim LastRow As Long
Dim OrderNo As String
Dim OrderMatch As Boolean
Dim i As Long

Application.ScreenUpdating = False
LastRow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
    If Sheets(1).Cells(i, 1).Value = OrderNo Then
        OrderMatch = True
    End If
    OrderNo = Sheets(1).Cells(i, 1).Value
    OutputRow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
    If OrderMatch = False Then
        Sheets(2).Cells(OutputRow + 1, 1).Value = "POH"
        Sheets(2).Cells(OutputRow + 1, 4).Value = OrderNo
        Sheets(2).Cells(OutputRow + 1, 9).Value = Sheets(1).Cells(i, 4).Value
        Sheets(1).Range(Cells(i, 12), Cells(i, 15)).Copy Destination:=Sheets(2).Cells(OutputRow + 1, 36)
        Sheets(2).Cells(OutputRow + 2, 1).Value = "POL"
        Sheets(2).Cells(OutputRow + 2, 4).Value = Sheets(1).Cells(i, 2).Value
        Sheets(2).Cells(OutputRow + 2, 5).Value = Sheets(1).Cells(i, 3).Value
        Sheets(2).Cells(OutputRow + 2, 12).Value = Sheets(1).Cells(i, 7).Value
        Sheets(2).Cells(OutputRow + 2, 16).Value = Sheets(1).Cells(i, 10).Value
    Else
        Sheets(2).Cells(OutputRow + 1, 1).Value = "POL"
        Sheets(2).Cells(OutputRow + 1, 4).Value = Sheets(1).Cells(i, 2).Value
        Sheets(2).Cells(OutputRow + 1, 5).Value = Sheets(1).Cells(i, 3).Value
        Sheets(2).Cells(OutputRow + 1, 12).Value = Sheets(1).Cells(i, 7).Value
        Sheets(2).Cells(OutputRow + 1, 16).Value = Sheets(1).Cells(i, 10).Value
    End If
    OrderMatch = False
Next i
Application.ScreenUpdating = True
End Sub

It isn't my most elegant work, but the procedure below seems to work for me. Take a look:

Sub FillOutput()
Dim OutputRow As Long
Dim LastRow As Long
Dim OrderNo As String
Dim OrderMatch As Boolean
Dim i As Long

Application.ScreenUpdating = False
LastRow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
    If Sheets(1).Cells(i, 1).Value = OrderNo Then
        OrderMatch = True
    End If
    OrderNo = Sheets(1).Cells(i, 1).Value
    OutputRow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
    If OrderMatch = False Then
        Sheets(2).Cells(OutputRow + 1, 1).Value = "POH"
        Sheets(2).Cells(OutputRow + 1, 4).Value = OrderNo
        Sheets(2).Cells(OutputRow + 1, 9).Value = Sheets(1).Cells(i, 1).Value
        Sheets(1).Range(Cells(i, 12), Cells(i, 15)).Copy Destination:=Sheets(2).Cells(OutputRow + 1, 36)
        Sheets(2).Cells(OutputRow + 2, 1).Value = "POL"
        Sheets(2).Cells(OutputRow + 2, 4).Value = Sheets(1).Cells(i, 2).Value
        Sheets(2).Cells(OutputRow + 2, 5).Value = Sheets(1).Cells(i, 3).Value
        Sheets(2).Cells(OutputRow + 2, 12).Value = Sheets(1).Cells(i, 7).Value
        Sheets(2).Cells(OutputRow + 2, 16).Value = Sheets(1).Cells(i, 10).Value
    Else
        Sheets(2).Cells(OutputRow + 1, 1).Value = "POL"
        Sheets(2).Cells(OutputRow + 1, 4).Value = Sheets(1).Cells(i, 2).Value
        Sheets(2).Cells(OutputRow + 1, 5).Value = Sheets(1).Cells(i, 3).Value
        Sheets(2).Cells(OutputRow + 1, 12).Value = Sheets(1).Cells(i, 7).Value
        Sheets(2).Cells(OutputRow + 1, 16).Value = Sheets(1).Cells(i, 10).Value
    End If
    OrderMatch = False
Next i
Application.ScreenUpdating = True
End Sub

I honestly can't thank you enough, this is a massive help.

Thanks man