VBA code to transpose rows to columns and copy data

S

SCotUS

New Member
Joined
Apr 13, 2023
Messages
3
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
Hi. I've been searching for answers and trying sketchy code, but I can't get anything to work for me.

I have a spreadsheet with over 10 thousand rows of data. Each row shows the ship date of the serial number, or numbers, that shipped that day. Some days we shipped one SN. Other days we shipped up to 32 SNs. All of the SNs are listed on one row for the day they shipped.

I need code that will look to see if there is more than one SN that shipped that day and put each SN on its own row with the associated row data (Col A thru Col K). The SNs start at Col L and extend to Col AQ (but may be more in the future). The Ship Date column is Col I. Row one is the header row (this needs to stay intact). After the transpositioning is done, it needs to delete duplicate rows where all of the data (Col A thru Col L) in that row matches.

Thank you in advance for your help!

Sandbox.xlsm
ABCDEFGHIJKLMNOPQ
1C1C2C3C4C5C6C7C7C8 Ship DateC9C10 SN01SN02SN03SN04SN05SN06
22082616327CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL11/21/2016ABC194142156847
32082616327CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL11/21/2016ABC194142156848
42082616328CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL11/21/2016ABC19414216807682268236838
52083914104CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC11/21/2016ABC1941421608263646528666766846710
62083917066CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC11/21/2016ABC1941421397655245730579058276016
72082616328CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL11/30/2016ABC19414222686668676868686968716872
82082616328CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL11/30/2016ABC19414215683768496850685168526853
92082616328CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL11/30/2016ABC1941424685468576859686068616862
102082616328CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL11/30/2016ABC194142668746881
112030382311CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC12/06/2016ABC19414211735
122037908237CUSTOMER SUPPORT RAILROAD19414258830LMN346682604XDR50-RV134XDR50-RV13-121340ABC12/06/2016ABC19414211903
132055620800CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC12/09/2016ABC19414214286
142082616355CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL12/20/2016ABC194142869306931
152082616355CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL12/21/2016ABC1941426686468706875687668796880
162082616355CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL12/21/2016ABC1941422686568736874687768826883
172085922992CUSTOMER SUPPORT343762104170LMN6138600014XDR50-RV134XDR50-RV13-214853GHI12/23/2016ABC343762166905
182082616355CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL12/21/2016ABC1941422689368956902690369046906
192062992652CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC01/23/2017ABC19414215300
202055617837CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC01/24/2017ABC19414213444
212066705244CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC01/24/2017ABC19414213688
222067457837CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC01/18/2017ABC19414213904
232082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL01/24/2017ABC19414212699369946995699669976998
242082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL01/26/2017ABC19414212701370147015701670177018
252030385244CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC01/24/2017ABC19414213764
262082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL01/26/2017ABC1941421270217023702470257026
272082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL01/26/2017ABC194142770007001
282082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL01/27/2017ABC1941429606968586898691069116912
292082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL01/30/2017ABC194142570027003700470057006
302082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL01/30/2017ABC194142270097010
312076604504CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC01/30/2017ABC19414215255
322074657837CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC02/02/2017ABC19414214346
332072554133CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC01/30/2017ABC19414215006
342072551170CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340ABC01/30/2017ABC19414215815
352082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL01/30/2017ABC194142870117012
362082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL01/30/2017ABC1941425689969006901691569166920
372082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL01/31/2017ABC194142270287029
382082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL02/03/2017ABC194142270377039704170457046
392082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL02/03/2017ABC1941428704770487049
402082616356CUSTOMER SUPPORT RAILROAD19414258830LMN346682104XDR50-RV134XDR50-RV13-121340JKL02/03/2017ABC1941422690869176918692369246925
Sandbox
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
I just had another thought. Can you have the transposed rows saved to another worksheet in the same workbook? That way I can retain the original data untouched. Thanks!
 
Upvote 0
Hello. Try with:

VBA Code: 
Sub Macro8()
Dim a, b, Q&, i&, R&, qCol%, j%, k%
Application.ScreenUpdating = False
'---------------------->
With Sheets("Sandbox")
  a = .Cells(1).CurrentRegion: Q = UBound(a): qCol = [L1].Column
  R = WorksheetFunction.Count(.Range("L1", .Cells(1, Columns.Count).End(xlToLeft)).Resize(Q))
  ReDim b(1 To R, 1 To qCol): R = 0
End With
'---------------------->
For i = 2 To Q
  For j = qCol To UBound(a, 2)
    If a(i, j) = Empty Then Exit For
    R = 1 + R
    For k = 1 To qCol - 1: b(R, k) = a(i, k): Next
    b(R, qCol) = a(i, j)
  Next
Next
'---------------------->
Worksheets.Add , Sheets("Sandbox")
Sheets("Sandbox").Range("a1:L1").Copy [a1]: [L1] = "<SN>"
[a2].Resize(R, UBound(b, 2)) = b
With Range("A1").CurrentRegion
  .Font.Name = "Tahoma": .Font.Size = 12
  .Columns.AutoFit
  Rows.RowHeight = 20
End With
'---------------------->
End Sub
 
Last edited:
Upvote 0
Solution
Mario_R said:
Hello. Try with:

VBA Code: 
Sub Macro8()
Dim a, b, Q&, i&, R&, qCol%, j%, k%
Application.ScreenUpdating = False
'---------------------->
With Sheets("Sandbox")
  a = .Cells(1).CurrentRegion: Q = UBound(a): qCol = [L1].Column
  R = WorksheetFunction.Count(.Range("L1", .Cells(1, Columns.Count).End(xlToLeft)).Resize(Q))
  ReDim b(1 To R, 1 To qCol): R = 0
End With
'---------------------->
For i = 2 To Q
  For j = qCol To UBound(a, 2)
    If a(i, j) = Empty Then Exit For
    R = 1 + R
    For k = 1 To qCol - 1: b(R, k) = a(i, k): Next
    b(R, qCol) = a(i, j)
  Next
Next
'---------------------->
Worksheets.Add , Sheets("Sandbox")
Sheets("Sandbox").Range("a1:L1").Copy [a1]: [L1] = "<SN>"
[a2].Resize(R, UBound(b, 2)) = b
With Range("A1").CurrentRegion
  .Font.Name = "Tahoma": .Font.Size = 12
  .Columns.AutoFit
  Rows.RowHeight = 20
End With
'---------------------->
End Sub
Click to expand...
This worked perfectly! Thank you!
 
Upvote 1
It was a pleasure helping you: see you next time.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
VBA Copy & Paste Values onto itself based on Criteria
Replies
4
Views
235
mst3kr
M
2
  • Question
VBA Copy Data from Sheet to Email depending on Assignee
Replies
2
Views
351
2000km12
2
E
  • Question
Copy rows to another worksheet based on dynamic criteria
Replies
0
Views
472
Emily20
E
J
  • Solved
Add 1 day to a date within a range as long as 2 conditions are met [without macros]
Replies
4
Views
565
juanam
J
B
  • Question
Copying Data from Sheet 1 to Sheet 2 and adding rows- Code Needed
2 3 4
Replies
30
Views
812
mumps
mumps

Forum statistics

Threads
1,214,927
Messages
6,122,311
Members
449,080
Latest member
jmsotelo

Share this page

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