How to convert a list of data into a table? Please help!

[mfxuus]

Hi all,

The attached file is a sample of what I need to do. Sheet one is original format and sheet two is what I want.

Basically the original format is a long list of data, and I need to put each observation into a row, while putting the values into the correct columns. The few tricky points are that for the "AU","AI","DE","KW","AF", the numbers vary. Some observations have just one each, but some have 2,or 3 or more, so in the list, each observation takes up a different length of range. For those that have multiple "AU"'s, the table version would need to have "AU_1", "AU_2"....

I have an idea about how to achieve this, but I have little experience with VBA, so I don't even know how to get started. Can I say something like: (not in VBA codes)

i=1, j=0
For i<=100000:
Look at Ai,
if Ai="$$":
j=j+1
i=i+1

if Ai="AN", then let Aj(in sheet 2)= Bi(in sheet 1)
i=i+1
if Ai="ST", then let Bj (in sheet 2)=Bi(in sheet 1)
i=i+1
...
....
if Ai="AU", if Gj = "", Gj=Bi
if Gj !="", if Ij="", Ij=Bi
if Ij != "", if Kj="", Kj=Bi.....
i=i+1
if Ai="AI", .....
and so on,,

you get the idea, I know this is probably the most inefficient way to do it, but even so I don't know how to write out the code.. Any help would be appreciated!!!
Thanks!!

 

[p45cal]

I would liked to have known you had cross-posted this here:
http://www.ozgrid.com/forum/showthread.php?t=183503
before I spent significant time on this. Grrrr.

(bullet points 6,7 & 8 under Please don't here:http://chandoo.org/forum/threads/new-users-please-read.294/
Some light reading:http://www.excelguru.ca/content.php?184

In the case of the KWs:
1. In your sample there's only 1 KW row per AN record; is this always the case?
2. You seem to split the KW value by the ';' character, except for the KW in row 71 of the before sheet, is this intentional?
3. Will there ever be more than one ';' character in a KW row?

Assuming answers:
1. Yes
2. No
3. Yes (but the code below limits this to the first 6 since you have 6 KW columns in your after sheet).

Sub blah()
Set DestSht = Sheets.Add(After:=Sheets(Sheets.Count))
DestRow = 1
With DestSht
  x = Array("AN", "ST", "IS", "CI_1", "CI_2", "PD", "DJ", "AU_1", "AI_1", "AU_2", "AI_2", "AU_3", "AI_3", "AU_4", "AI_4", "AU_5", "AI_5", "AU_6", "AI_6", "AU_7", "AI_7", "TI", "DE_1", "DE_2", "DE_3", "DE_4", "DE_5", "DE_6", "DE_7", "KW_1", "KW_2", "KW_3", "KW_4", "KW_5", "KW_6", "AF_1", "AF_2", "AF_3", "AF_4", "AF_5", "AF_6", "AF_7")
  .Range("A1").Resize(, 42) = x
  For Each cll In Sheets("before").UsedRange.Columns(1).Cells
    Select Case cll.Value
      Case ""
      Case "$$": DestRow = DestRow + 1
        .Cells(DestRow, 1).Resize(, 42).NumberFormat = "@"
        AuCount = 0
        AiCount = 0
        DeCount = 0
        AfCount = 0
      Case "AN", "ST", "IS", "PD", "DJ", "TI": .Cells(DestRow, Application.Match(cll.Value, x, 0)) = cll.Offset(, 1).Value
      Case "AU": AuCount = AuCount + 1: .Cells(DestRow, Application.Match(cll.Value & "_" & AuCount, x, 0)) = cll.Offset(, 1).Value
      Case "AI": AiCount = AiCount + 1: .Cells(DestRow, Application.Match(cll.Value & "_" & AiCount, x, 0)) = cll.Offset(, 1).Value
      Case "DE"
      lob = InStrRev(cll.Offset(, 1).Value, "(")
      de = Split(Mid(cll.Offset(, 1).Value, lob + 1), ")") 'if there are no brackets in the text, this will fail.
      DeCount = DeCount + 1: .Cells(DestRow, Application.Match(cll.Value & "_" & DeCount, x, 0)) = de
      Case "AF": AfCount = AfCount + 1: .Cells(DestRow, Application.Match(cll.Value & "_" & AfCount, x, 0)) = cll.Offset(, 1).Value
      Case "KW"
      xx = Split(cll.Offset(, 1).Value, ";")
      If IsArray(xx) Then
      For i = LBound(xx) To Application.Min(5, UBound(xx))
        .Cells(DestRow, Application.Match("KW_" & i + 1, x, 0)) = Application.Trim(xx(i))
      Next i
      Else
          .Cells(DestRow, Application.Match("KW_1", x, 0)) = cll.Offset(, 1).Value
      End If
      Case "CI"
        xx = Split(cll.Offset(, 1).Value)
        If IsArray(xx) Then
          .Cells(DestRow, Application.Match("CI_1", x, 0)) = xx(0)
          .Cells(DestRow, Application.Match("CI_2", x, 0)) = xx(1)
        Else
          .Cells(DestRow, Application.Match("CI_1", x, 0)) = cll.Offset(, 1).Value
        End If
    End Select
  Next cll
End With
End Sub

 

[mfxuus]

I have apologized over at the other forum, but just for the sake of completeness..
I didn't cross-post link because this is where I posted first, and when I posted it I didn't even know there were other forums, not to say know I would post anywhere else.. But yeah, I admit I should've had thought of editting the original post and add the cross-post link once I posted elsewhere.

And your code works perfectly, thank you so much for your time and effort!!

...And I feel terrible to ask you for more, but could you possibly expand the KW to more, say 10 or even more, since I have no idea what is the max of it in the data, but I found one that has 7.. I like your answer because yours takes care of extracting numbers from the parentheses in the DEs as well.. If it's too much trouble then don't bother, you've already done a lot!!

 

[Marc L]

Hi,​

​

instead of creating a lot of columns in advance,​

I prefer to just create the necessary number dynamically during the process :​

Sub ConvertList2Table(Source As Worksheet, Destination As Worksheet)
    Dim Rg As Range, Cel1 As Range, Cel2 As Range, Cel As Range
    Set Rg = Source.[A1].CurrentRegion
 
    If Rg.Rows.Count > 1 And Rg.Columns.Count = 2 And Rg(1).Text = "$$" Then
        With Destination
            Application.ScreenUpdating = False
            .UsedRange.Clear
            Set Cel2 = Rg(1)
                TYP = [{"CI","KW"}]:  SEP = [{" ",";"}]
            Do
                Set Cel1 = Cel2(2)
                Set Cel2 = Rg.Columns(1).Find("$$", Cel2, xlValues, xlWhole)
 
                If Cel2.Row > Cel1.Row Then
                    If R& = 0 Then
                        Range(Cel1, Cel2(0)).Copy
                        .[A1].PasteSpecial Transpose:=True
                        Application.CutCopyMode = False
                                              R = 1
                    End If
 
                    .UsedRange.Rows(1).Offset(R).NumberFormat = "@"
                    C = 1:  R = R + 1
 
                    For Each Cel In Range(Cel1, Cel2(0))
                        If Cel.Text <> T$ Then
                            T = Cel.Text
 
                            Do While .UsedRange.Columns.Count > C And .Cells(C).Text <> T
                                C = C + 1
                            Loop
 
                            If .Cells(C).Text <> T Then Exit For
                            P = Application.Match(T, TYP, 0)
                        End If
 
                        S$ = Cel(, 2).Text
 
                        If IsError(P) Then
                            If T = "DE" Then
                                N& = InStrRev(S, "(")
                                If N Then S = Split(Mid(S, N + 1), ")")(0)
                            End If
 
                            SP = Array(S)
 
                        Else
                            SP = Split(S, SEP(P))
                        End If
 
                        For N = 0 To UBound(SP)
                            SP(N) = Trim(SP(N))
 
                            If .Cells(C + N).Text <> T Then
                               .Cells(C + N).EntireColumn.Insert
                               .Cells(C + N).Value = T
                            End If
                        Next N
 
                        .Cells(R, C).Resize(, UBound(SP) + 1).Value = SP
                        C = C + UBound(SP) + 1
                    Next Cel
                End If
            Loop While Cel2.Row > Cel1.Row
 
            Erase SEP, TYP
            Set Cel1 = Nothing:  Set Cel2 = Nothing
            .Activate
            Cells(R + 1, 1).Select
            Application.ScreenUpdating = True
        End With
    End If
 
    Set Rg = Nothing
End Sub
 
 
Sub Demo()
    ConvertList2Table Sheet1, Sheet3
End Sub

This procedure operates well if columns of each row are the same and in the same order than first row …​

​

Like it !​