Converting many rows into a single column

[Limey2632]

Hi Folks,
I apologize for my title. I'm not exactly sure what to call it. It's not transposing exactly as I want everything in a single column, not multiple columns.
I have to provide our company planners data in a particular format. I have the data in a spreadsheet where the related info is in rows. There is an ID#, a Product name, Sku1, Sku2 and Sku3

The data in the example below is different from above but it demonstrates the layout required.
The sku numbers are placed under the product name in a single column and the ID# is in a column to the left. The column ID# shows for each component of the original row.
For example, the first 3 rows would have come from 1 RHYTHM 37869 745T7. As can be seen, the ID# in col.A beside the data in B is "1".

Is this possible to do in Excel with either formula(s), VBA or other technique?

Many thanks,
Limey

 

[footoo]

To do manually :
• Insert a column before each of the columns C,D and E.
• Put the formula =A2 in each of the new columns and fill down.
• Copy column C:D from the second row and paste at the bottom of A:B.
• Do the same for columns E:F and G:H.
• Delete rows that contain blanks in column B. (via SpecialCells)
• Delete columns C:H.
• Sort the data by column A.
• Fill column C with 1 (what is the purpose of this?).

 

[kweaver]

@limey ... please update your profile to reflect the version of Excel you run.

 

[Limey2632]

@limey ... please update your profile to reflect the version of Excel you run.

I am not sure what boxes to check in the profile as for the year but I have 2 MACs that are running 16.54 and 16.72.

 

[Limey2632]

To do manually :
• Insert a column before each of the columns C,D and E.
• Put the formula =A2 in each of the new columns and fill down.
• Copy column C:D from the second row and paste at the bottom of A:B.
• Do the same for columns E:F and G:H.
• Delete rows that contain blanks in column B. (via SpecialCells)
• Delete columns C:H.
• Sort the data by column A.
• Fill column C with 1 (what is the purpose of this?).

Thank you for your reply. I will see if this manual method is faster than what we have been doing. I was hoping there would be a "clever", perhaps more automated way to do it. I appreciate your time taken to respond.

 

[footoo]

Thank you for your reply. I will see if this manual method is faster than what we have been doing. I was hoping there would be a "clever", perhaps more automated way to do it. I appreciate your time taken to respond.

If you post your sample data in a form that can be copied to an Excel sheet, I will do a macro

 

[Limey2632]

If you post your sample data in a form that can be copied to an Excel sheet, I will do a macro

I'm sorry if this is no use but I'm having trouble providing an easy way to pass on the data. I'm using a work computer. I assume the Upload Mini Script is the way to do it but IT dept. are strict on downloading programs.

 

[Limey2632]

Oops, sent before I'd finished posting. There must be a keyboard shortcut to send
ID# Product Name sku sku sku1
1 RHYTHM 37869 745T7
2 RHYTHM N3786 747T7
3 RHYTHM J8517 749T7
4 RHYTHM N3789 751T7
5 RHYTHM 754J0 753T7
6 RHYTHM 756J0 755T7
7 RHYTHM 759J0 757T7
8 RHYTHM 1C030 96C64 759T7
9 RHYTHM 1G480 96C65 761T7
10 RHYTHM 80379 763T7
11 RHYTHM K1148 765T7

 

[kweaver]

Likely a shorter way, but this might work and place the "stacked" data in columns G and H respectively

Sub StackID()
Dim lr As Long, i As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
r = 2

 For i = 2 To lr
  Range("G" & r & ":G" & r + WorksheetFunction.CountA(Range("C" & i & ":E" & i))) = Cells(i, "A")
  Cells(r, "H") = Cells(i, "B")
  r = r + 1
  If Not IsEmpty(Cells(i, "C")) Then
   Cells(r, "H") = Cells(i, "C")
   r = r + 1
   End If
  If Not IsEmpty(Cells(i, "D")) Then
   Cells(r, "H") = Cells(i, "D")
   r = r + 1
   End If
  If Not IsEmpty(Cells(i, "E")) Then
   Cells(r, "H") = Cells(i, "E")
   r = r + 1
  End If
  
 Next i
  
End Sub

 

[footoo]

Here's another way :

Sub StackID()
Dim rng As Range, lr&, c&
Application.ScreenUpdating = False
[D:D,E:E].Insert
For c = 4 To 6 Step 2
    lr = Cells(Rows.Count, c + 1).End(3).Row
    Set rng = Columns(c).Resize(lr - 1).Offset(1)
    rng = Evaluate("ROW(" & rng.Address & ")-1")
    With Range(Cells(2, c), Cells(lr, c))
        .Copy Cells(Rows.Count, "A").End(3)(2)
        .Offset(0, 1).Copy Cells(Rows.Count, "C").End(3)(2)
    End With
Next
Intersect(ActiveSheet.UsedRange, [B:B].SpecialCells(xlCellTypeBlanks)) = "RHYTHM"
On Error Resume Next
[C:C].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
[D:G].Delete
ActiveSheet.Sort.SortFields.Clear
[A:A].EntireRow.Sort Key1:=[A1], Header:=xlYes
End Sub