Need a macro that I don't even think can fix this problem

[GirlG]

Good Afternoon -
I'm going to do my best to make this look right on the screen.


3128
Product number: 7896
Product: Apples
Importer: Rick
Owner: Gyna
Name of receiver: Bill
Number of cases: 1232
Date: 10/15/18
Amount: $3.00


7898
Product number: 456
Product: Oranges
Importer: Richard
Owner: Gyna
Name of receiver: Henry
Number of cases: 1
Date: 10/15/18
Amount: $13.00
Approval: N/A


OK... so I need this transposed. There are hundreds of these. Some on them have 5 lines of information, some 6 and some 7.
Is there a macro that can tell Excel 2016 to grab the information from a row labeled ie "owner" and place it in a column named "owner"?
I am dealing with garbage data.
Does this even make sense?


And mind you... This information has been exported out of a PDF. They are purposely making this difficult if I have to guess.

 

[mrshl9898]

This looks to be working, but assumes all groups? have a "Product number" and all data is in column A.

In C1:J1 have the headings:
[TABLE="width: 649"]
<tbody>[TR]
[TD="width: 108"]Product number[/TD]
[TD="width: 86"] Product[/TD]
[TD="width: 62"]Importer[/TD]
[TD="width: 49"]Owner[/TD]
[TD="width: 115"]Name of receiver[/TD]
[TD="width: 111"]Number of cases[/TD]
[TD="width: 61"] Date[/TD]
[TD="width: 57"]Amount[/TD]
[/TR]
</tbody>[/TABLE]

Then the code:

Sub Transpose()


Dim rownum As Long
Dim rownum2 As Long
Dim lastrow As Long
Dim colname As String
Dim colnum As Long
Dim namelen As Long
Dim copystr As String


lastrow = Cells(Rows.Count, 1).End(xlUp).Row
colnum = 3 'table starts in column C
rownum2 = 1


Do Until Cells(1, colnum).Value = ""
colname = Cells(1, colnum) & ":"
namelen = Len(colname)


rownum = 1
Do Until rownum = lastrow
If Left(Cells(rownum, 1), 14) = "Product number" Then
rownum2 = rownum2 + 1
End If
If Left(Cells(rownum, 1), namelen) = colname Then
copystr = Mid(Cells(rownum, 1), namelen + 2, 30)
Cells(rownum2, colnum).Value = copystr
End If
rownum = rownum + 1
Loop


rownum2 = 1
colnum = colnum + 1
Loop


End Sub

 

[Fluff]

Another option

Sub TransposeData()
   Dim Ary As Variant, Hdr As Variant, c As Variant
   Dim Rng As Range, Cl As Range
   Dim i As Long
   
   Hdr = Array("Product number", "Product", "Importer", "Owner", "Name of receiver", "Number of cases", "Date", "Amount", "Approval")
   ReDim Ary(1 To Range("A" & Rows.Count).End(xlUp).Row, 1 To UBound(Hdr) + 1)
   For Each Rng In Range("A:A").SpecialCells(xlConstants).Areas
      i = i + 1
      For Each Cl In Rng
         c = Application.Match(Split(Cl, ":")(0), Hdr, 0)
         If Not IsError(c) Then
            Ary(i, c) = Split(Cl, ":")(1)
         End If
      Next Cl
   Next Rng
   Range("C1").Resize(, UBound(Hdr) + 1).Value = Hdr
   Range("C2").Resize(i, UBound(Hdr) + 1).Value = Ary
End Sub

This assumes that there are empty cells between each section

 

[GirlG]

OMG!!! Thank you sooo much! That was more help than I could have asked for. I would love to learn how to do all of this. I know it is something you have been learning for years. Any tips about where to start?
Thank you, thank you, thank you!

G

 

[Fluff]

Not sure which of us you are talking too, but I started out by recording macros, then modifying them, then hunting around the web for existing code/ideas in order to write my own macros & finally (where I learnt the most) was helping other people on this forum.