Compiling a list of observations into a table

mfxuus · Oct 19th 2013

Hey 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 for different observations. 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!!

also posted on http://forum.chandoo.org/threa…-table-please-help.12720/

jindon · Oct 19th 2013

Re: Compiling a list of observations into a table

Why "CI" has "CI_1" & "CI_2" in the result ?

mfxuus · Oct 19th 2013

Re: Compiling a list of observations into a table

Oh that's just further decomposing the 2 numbers in CI to two columns, something that can be easily done so I didn't write it in there. Thanks for taking your time to look at it !!

jindon · Oct 19th 2013

Re: Compiling a list of observations into a table

1) Can you edit your last post and remove full quote of my post?
It should not be there unless it is really needed.

2) Assuming "CL","KW" has always 2 items.

mfxuus · Oct 19th 2013

Re: Compiling a list of observations into a table

and also the DE_1, DE_2...DE_i's in the result are just extracting the numbers from the parentheses of the original DE.. again something not too complicated. The main problem for me is to have the data formatted into these rows. Thanks!

mfxuus · Oct 19th 2013

Re: Compiling a list of observations into a table

Sorry, I'm not quite familiar with this forum... I am having some problem downloading your file, it says "Invalid Attachment specified. " You have any idea? Thanks!!

jindon · Oct 19th 2013

Re: Compiling a list of observations into a table

I have downloaded it with no error.

Do you want to try it again?

Code is

Code

Option Explicit




Sub test()
    Dim myAreas As Areas, i As Long, a, ii As Long, dic As Object, AL As Object, x As Object
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    Set AL = CreateObject("System.Collections.ArrayList")
    Set x = CreateObject("System.Collections.ArrayList")
    With Cells(1).CurrentRegion
        With .Columns(3)
            .Formula = "=if(a1=""AN"",1,"""")"
            On Error Resume Next
            .SpecialCells(-4123, 1).EntireRow.Insert
            On Error GoTo 0
        End With
    End With
    Set myAreas = Columns(2).SpecialCells(2).Areas
    For i = 1 To myAreas.Count
        Set dic(i) = CreateObject("Scripting.Dictionary")
        For ii = 1 To myAreas(i).Rows.Count
            If Not dic(i).exists(myAreas(i)(ii, 0).Value) Then
                Set dic(i)(myAreas(i)(ii, 0).Value) = _
                CreateObject("Scripting.Dictionary")
            End If
            dic(i)(myAreas(i)(ii, 0).Value) _
            (dic(i)(myAreas(i)(ii, 0).Value).Count + 1) = _
            myAreas(i)(ii, 1).Value
            If dic(i)(myAreas(i)(ii, 0).Value).Count > 1 Then
                If AL.contains(myAreas(i)(ii, 0).Value) Then
                    If Not x.contains(myAreas(i)(ii, 0).Value) Then x.Add myAreas(i)(ii, 0).Value
                    If Not AL.contains(myAreas(i)(ii, 0).Value & "_1") Then
                        AL.Add myAreas(i)(ii, 0).Value & "_1"
                    End If
                End If
                If Not AL.contains(myAreas(i)(ii, 0).Value & "_" & dic(i)(myAreas(i)(ii, 0).Value).Count) Then
                    AL.Add myAreas(i)(ii, 0).Value & "_" & dic(i)(myAreas(i)(ii, 0).Value).Count
                End If
            Else
                If Not AL.contains(myAreas(i)(ii, 0).Value) Then AL.Add myAreas(i)(ii, 0).Value
            End If
        Next
    Next
    Columns(1).SpecialCells(4).EntireRow.Delete: Columns(3).Clear
    DumpData dic, AL, x
    Application.ScreenUpdating = True
End Sub




Private Sub DumpData(dic As Object, AL As Object, x As Object)
    Dim a, i As Long, ii As Long, e
    For i = 0 To x.Count - 1
        AL.removeat AL.indexof(x(i), 0)
    Next
    AL.removeat AL.indexof("AN", 0)
    AL.Sort: AL.Insert 0, "AN"
    ReDim a(1 To dic.Count + 1, 1 To AL.Count)
    For i = 0 To AL.Count - 1
        a(1, i + 1) = AL(i)
    Next
    For i = 1 To dic.Count
        For Each e In dic(i).keys
            If dic(i)(e).Count = 1 Then
                If AL.indexof(e, 0) = -1 Then
                    a(i + 1, AL.indexof(e & "_1", 0) + 1) = dic(i)(e).items()(0)
                Else
                    a(i + 1, AL.indexof(e, 0) + 1) = dic(i)(e).items()(0)
                End If
            Else
                For ii = 0 To dic(i)(e).Count - 1
                    a(i + 1, AL.indexof(e & "_" & ii + 1, 0) + 1) = dic(i)(e).items()(ii)
                Next
            End If
        Next
    Next
    With Sheets.Add.Cells(1).Resize(UBound(a, 1), UBound(a, 2))
        .Value = a
        For Each e In Array(Array("CI", " "), Array("KW", ";"))
            With .Rows(1).Find(e(0))
                .Offset(, 1).EntireColumn.Insert
                .EntireColumn.TextToColumns Destination:=.Cells, Other:=True, OtherChar:=e(1)
                .Resize(, 2).Value = Array(e(0) & "_1", e(0) & "_2")
            End With
        Next
    End With
End Sub

Display More

mfxuus · Oct 19th 2013

Re: Compiling a list of observations into a table

This is great!! As long as Keywords are fewer than 2 it worked just as expected, however, there are cases where they have as many as 7 keywords (perhaps even more, there's literally millions of lines so I can't really know the max)..Is there a way to modify the code to accommodate that? Hope that it won't be too much trouble, this is already very impressive! moments like this make me want to master these skills at once, but I'm still at the very beginner of writing for loops in python:-(

jindon · Oct 19th 2013

Re: Compiling a list of observations into a table

Code

Option Explicit


Sub test()
    Dim myAreas As Areas, i As Long, a, ii As Long, iii As Long, dic As Object, AL As Object, x As Object, temp
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    Set AL = CreateObject("System.Collections.ArrayList")
    Set x = CreateObject("System.Collections.ArrayList")
    With Cells(1).CurrentRegion
        With .Columns(3)
            .Formula = "=if(a1=""AN"",1,"""")"
            On Error Resume Next
            .SpecialCells(-4123, 1).EntireRow.Insert
            On Error GoTo 0
        End With
    End With
    Set myAreas = Columns(2).SpecialCells(2).Areas
    For i = 1 To myAreas.Count
        Set dic(i) = CreateObject("Scripting.Dictionary")
        For ii = 1 To myAreas(i).Rows.Count
            If Not dic(i).exists(myAreas(i)(ii, 0).Value) Then
                Set dic(i)(myAreas(i)(ii, 0).Value) = CreateObject("Scripting.Dictionary")
            End If
            Select Case myAreas(i)(ii, 0).Value
                Case "CI": temp = Split(myAreas(i)(ii, 1).Value)
                Case "KW": temp = Split(myAreas(i)(ii, 1).Value, ";")
                Case Else: temp = Empty
            End Select
            If IsArray(temp) Then
                For iii = 0 To UBound(temp)
                    dic(i)(myAreas(i)(ii, 0).Value)(iii + 1) = Trim$(temp(iii))
                    If Not AL.contains(myAreas(i)(ii, 0).Value & "_" & iii + 1) Then
                        AL.Add myAreas(i)(ii, 0).Value & "_" & iii + 1
                    End If
                Next
            Else
                dic(i)(myAreas(i)(ii, 0).Value) _
                (dic(i)(myAreas(i)(ii, 0).Value).Count + 1) = _
                myAreas(i)(ii, 1).Value
                If dic(i)(myAreas(i)(ii, 0).Value).Count > 1 Then
                    If AL.contains(myAreas(i)(ii, 0).Value) Then
                        If Not x.contains(myAreas(i)(ii, 0).Value) Then x.Add myAreas(i)(ii, 0).Value
                        If Not AL.contains(myAreas(i)(ii, 0).Value & "_1") Then
                            AL.Add myAreas(i)(ii, 0).Value & "_1"
                        End If
                    End If
                    If Not AL.contains(myAreas(i)(ii, 0).Value & "_" & dic(i)(myAreas(i)(ii, 0).Value).Count) Then
                        AL.Add myAreas(i)(ii, 0).Value & "_" & dic(i)(myAreas(i)(ii, 0).Value).Count
                    End If
                Else
                    If Not AL.contains(myAreas(i)(ii, 0).Value) Then AL.Add myAreas(i)(ii, 0).Value
                End If
            End If
        Next
    Next
    Columns(1).SpecialCells(4).EntireRow.Delete: Columns(3).Clear
    DumpData dic, AL, x
    Application.ScreenUpdating = True
End Sub


Private Sub DumpData(dic As Object, AL As Object, x As Object)
    Dim a, i As Long, ii As Long, e
    For i = 0 To x.Count - 1
        AL.removeat AL.indexof(x(i), 0)
    Next
    AL.removeat AL.indexof("AN", 0)
    AL.Sort: AL.Insert 0, "AN"
    ReDim a(1 To dic.Count + 1, 1 To AL.Count)
    For i = 0 To AL.Count - 1
        a(1, i + 1) = AL(i)
    Next
    For i = 1 To dic.Count
        For Each e In dic(i).keys
            If dic(i)(e).Count = 1 Then
                If AL.indexof(e, 0) = -1 Then
                    a(i + 1, AL.indexof(e & "_1", 0) + 1) = dic(i)(e).items()(0)
                Else
                    a(i + 1, AL.indexof(e, 0) + 1) = dic(i)(e).items()(0)
                End If
            Else
                For ii = 0 To dic(i)(e).Count - 1
                    a(i + 1, AL.indexof(e & "_" & ii + 1, 0) + 1) = dic(i)(e).items()(ii)
                Next
            End If
        Next
    Next
    Sheets.Add.Cells(1).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Display More

p45cal · Oct 19th 2013

Re: Compiling a list of observations into a table

Cross-posted here:
http://chandoo.org/forum/threa…-table-please-help.12720/
where I've made an offering; I wish I'd known of this thread before I put significant effort in. :censored:
(forum rule 4)

mfxuus · Oct 19th 2013

Re: Compiling a list of observations into a table

I did list the cross-posting link to this thread.... As to the chandoo forum, I sincerely apologize for having forgotten to do the same... Because that's where I posted first, and when I posted that 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.

jindon · Oct 19th 2013

Re: Compiling a list of observations into a table

mfxuus

You are doing nothing wrong here, however, as you stated, better give link the other forum as well.

Anyway, is it working?

mfxuus · Oct 19th 2013

Re: Compiling a list of observations into a table

Yep, works great! cannot thank you enough

mfxuus · Oct 19th 2013

Re: Compiling a list of observations into a table

...One thing that occurred when the CI is like " 3 3-12", the output for CI_2 is automatically converted into date format. I tried to use the substitute function but then it returns a few digits of numbers that are completely unrelated to 3-12... and then I tried =text(A1,"mm-dd") , it worked for the ones converted to date, but for those normal ones (CI="3 2"---> CI_1="3" CI_2="2") it converted to CI_2="01-02" ... And similar thing happened to "PD"..

I assume there is a way to format the output as text(or any way that would prevent excel from auto formatting), but where exactly should I add the formatting line in your code?

jindon · Oct 19th 2013

Re: Compiling a list of observations into a table

Change the last line

Code

Sheets.Add.Cells(1).Resize(UBound(a, 1), UBound(a, 2)).Value = a

to

Code

With Sheets.Add.Cells(1).Resize(UBound(a, 1), UBound(a, 2))
        .NumberFormat = "@"
        .Value = a
    End With

mfxuus · Oct 19th 2013

Re: Compiling a list of observations into a table

:wowee: "you rock!"

holycow · Oct 19th 2013

Re: Compiling a list of observations into a table

http://www.mrexcel.com/forum/e…ervations-into-table.html

mfxuus · Oct 20th 2013

Re: Compiling a list of observations into a table

I've already added the cross-link on that forum to the solutions on both Chandoo and this forum about 10 hours ago, and since there's nothing new over there I don't see the point of linking people over there. If you're just reminding me to cross-link, point well taken, I'm new, I'm learning, but someone had already pointed it out.

mfxuus · Oct 28th 2013

Re: Compiling a list of observations into a table

Just a followup question (hopefully the last one, since almost done with all the data..). for the variable DE, it turned out that although the delimiter is usually ";", sometimes it is ",". I looked into the code (jindon's) and tried to add something like an or "," to the relevant line, but it didn't work out. I'm assuming a very minor change could fix this problem, any suggestions? Thanks again!

jindon · Oct 28th 2013

Re: Compiling a list of observations into a table

Try change

Code

Case "KW": temp = Split(myAreas(i)(ii, 1).Value, ";")

to

Code

Case "KW": temp = Split(replace(myAreas(i)(ii, 1).Value,",",";"), ";")

Compiling a list of observations into a table

Participate now!

Share