Change list orientation

[cshenoy]

I have a list that I need to present in different ways at various times.

I have data in two columns, A and B. In column A each value is unique. In column B, I have 5 categories. I'd like to create a separate table beginning in column D with the categories in the first row, and each of the unique values under the appropriate category.

I'd also like to go back the other way. If I have 5 categories in the first row and the values listed below, I'd like to create a list with the values in one column and the associated categories in the other.

Any help would be most appreciated.

Cathy

[mbarron]

Use TallToShort to make the two column list into a table - the macro assumes the PM is sorted.

Code: Select all

Sub TallToShort()
Dim iCat As Integer, iCol As Integer, i As Integer, iRow As Integer
Dim curCat As String
i = 2
iCol = 3
iRow = 1
Do Until Cells(i, 2) = ""
    If Cells(i, 2) <> curCat Then
        curCat = Cells(i, 2)
        iCol = iCol + 1
        Cells(1, iCol) = curCat
        Cells(2, iCol) = Cells(i, 1)
        iRow = 3
    Else
        Cells(iRow, iCol) = Cells(i, 1)
        iRow = iRow + 1
    End If
    i = i + 1
Loop

End Sub

ShortToTall will take the category list and make it into the Ticker, PM list. The macro assumes you want to Ticker column 2 column to the right of the current table.

Code: Select all

Sub ShortToTall()
Dim i As Integer, iRow As Integer, iCol As Integer, j As Integer
iCol = Cells(1, Columns.Count).End(xlToLeft).Column
iRow = 2

Cells(1, lcol+2) = "Ticker"
Cells(1, lcol+3) = "PM"

For j = 1 To iCol
i = 2
    Do Until Cells(i, j) = ""
        Cells(iRow, lcol+2) =Cells(i, j)
        Cells(iRow,iCol+3)= Cells(1,j)
        iRow = iRow + 1
        i = i + 1
    Loop
Next

End Sub

[HansV]

Hi Cathy,

Welcome to Eileen's Lounge!

Here is a macro that will convert the two-column list to the 5-column table:

Code: Select all

Sub List2Table()
  Const lngColIn = 10
  Const lngColOut = 1
  Dim r As Long
  Dim m As Long
  Dim c As Long
  Dim t As Long
  ' Sort range on PM column
  Cells(1, lngColIn).CurrentRegion.Sort Key1:=Cells(1, lngColIn + 1), Header:=xlYes
  ' Last row
  m = Cells(Rows.Count, lngColIn).End(xlUp).Row
  ' Initialize output column
  c = lngColOut - 1
  ' Loop through rows
  For r = 2 To m
    ' New PM?
    If Not Cells(r, lngColIn + 1) = Cells(r - 1, lngColIn + 1) Then
      ' Next output column
      c = c + 1
      ' Copy PM name
      Cells(1, c) = Cells(r, lngColIn + 1)
      ' Initialize output row
      t = 1
    End If
    ' Next output row
    t = t + 1
    ' Copy Ticker name
    Cells(t, c) = Cells(r, lngColIn)
  Next r
End Sub

The converse will be in my next reply. I see that Mike already posted both...

[cshenoy]

Thanks to Hans and MIke! I appreciate it! I'm happy Hans told me about this Lounge. What a great place.