Transposing one column into three
Sub ChangeData()
'Assumptions
'Column headings in row 1
'Data starts in row 2
'VendorName is in column A
'Type (I,II,III) is in column B
Dim ws As Worksheet, wsNew As Worksheet
Dim c As Range
Dim lngVendorI As Long
Dim lngVendorII As Long
Dim lngVendorIII As Long
Set ws = ActiveSheet
ActiveWorkbook.Worksheets.Add
Set wsNew = ActiveSheet
With wsNew
.Range("A1").Value = "I"
.Range("B1").Value = "II"
.Range("C1").Value = "III"
End With
lngVendorI = 2
lngVendorII = 2
lngVendorIII = 2
For Each c In ws.Range("B2:B" & ws.Range("B65536").End(xlUp).Row)
Select Case c.Value
Case "I"
wsNew.Cells(lngVendorI, 1).Value = c.Offset(0, -1).Value
lngVendorI = lngVendorI + 1
Case "II"
wsNew.Cells(lngVendorII, 2).Value =
c.Offset(0, -1).Value
lngVendorII = lngVendorII + 1
Case "III"
wsNew.Cells(lngVendorIII, 3).Value =
c.Offset(0, -1).Value
lngVendorIII = lngVendorIII + 1
End Select
Next c
Set c = Nothing
Set ws = Nothing
Set wsNew = Nothing
End Sub
--
Dianne
In ,
Gilbert typed:
I have 2 columns of about 100 records.
First record is a vendor name, second record is either
I,II, or III. All vendor names are unique.
Out of this data I would like to build three columns. One
for "I" one for "II" and the last for "III". Of course
under these header would be the vendors names.
I was able to do it but I have three columns with blank
rows scattered all over.
I would appreciate any help or hint.
Thanks in advance
|