Columns to Range

[Drew Pihlainen]

I've got data in a format somewhat like this; essentially products sold on each day by each employee. The "Product" fields contain product numbers:

Name | Date | Product1 | Product2 | Product3 | Product4 |
John | 2 Aug | A506 | B207 | C405 | |
Mary | 2 Aug | B207 | D404 | | |
John | 5 Aug | A506 | C405 | | |
Mary | 6 Aug | E335 | | | |

I'd like the finished product to look something like this:

Name | Date | Product |
John | 2 Aug | A506 |
John | 2 Aug | B207 |
John | 2 Aug | C405 |
Mary | 2 Aug | B207 |
Mary | 2 Aug | D404 |
John | 5 Aug | A506 |
John | 5 Aug | C405 |
Mary | 6 Aug | E335 |

Any thoughts on how this might be done? Thanks!

 

[isabelle]

hi Drew,

Sub Macro1()
Dim i As Long, LastRow As Long, y As Integer, LastCol As Integer, rw As Long
rw = 1

Sheets("Sheet2").Cells(1, 1) = "Name"
Sheets("Sheet2").Cells(1, 2) = "Date"
Sheets("Sheet2").Cells(1, 3) = "Product"

With Sheets("Sheet1")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To LastRow
LastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
For y = 3 To LastCol
rw = rw + 1
Sheets("Sheet2").Cells(rw, 1) = .Cells(i, 1)
Sheets("Sheet2").Cells(rw, 2) = .Cells(i, 2)
Sheets("Sheet2").Cells(rw, 3) = .Cells(i, y)
Next
Next
End With

End Sub

isabelle


Le 2013-01-30 16:41, Drew Pihlainen a écrit :

 

[Drew Pihlainen]

Thanks, Isabelle! Worked like a charm...

hi Drew,



Sub Macro1()

Dim i As Long, LastRow As Long, y As Integer, LastCol As Integer, rw As Long

rw = 1



Sheets("Sheet2").Cells(1, 1) = "Name"

Sheets("Sheet2").Cells(1, 2) = "Date"

Sheets("Sheet2").Cells(1, 3) = "Product"



With Sheets("Sheet1")

LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

For i = 2 To LastRow

LastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column

For y = 3 To LastCol

rw = rw + 1

Sheets("Sheet2").Cells(rw, 1) = .Cells(i, 1)

Sheets("Sheet2").Cells(rw, 2) = .Cells(i, 2)

Sheets("Sheet2").Cells(rw, 3) = .Cells(i, y)

Next

Next

End With



End Sub



isabelle





Le 2013-01-30 16:41, Drew Pihlainen a �crit :

 

[isabelle]

glad to help. thanks for the feedback.

isabelle

Le 2013-01-30 19:23, Drew Pihlainen a écrit :