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

GirlG

New Member
Joined
Sep 12, 2018
Messages
3
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.
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
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:
Product number ProductImporterOwnerName of receiverNumber of cases DateAmount

<tbody>
</tbody>

Then the code:

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
 
Last edited:
Upvote 0
Another option
Code:
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
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top