VBA Automate Re-sort Complex Table

liz123

New Member
Joined
Aug 26, 2016
Messages
8
Dear Community,


I would like assistance to resort a series of logistic regressions tables that include (1) the variable name; (2) the standard error; (3) EXP(B); and (4) a starred version of significance level.

I have a series of tables one after the other in a single sheet, which use the following format:


[TABLE="width: 350"]
<tbody>[TR]
[TD]Var[/TD]
[TD]S.E.[/TD]
[TD]Exp(B)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]red[/TD]
[TD](.137)[/TD]
[TD]1.044[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]blue[/TD]
[TD](.141)[/TD]
[TD].936[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]green[/TD]
[TD](.150)[/TD]
[TD]1.427[/TD]
[TD]*[/TD]
[/TR]
[TR]
[TD]Constant[/TD]
[TD](.197)[/TD]
[TD].195[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Var[/TD]
[TD]S.E.[/TD]
[TD]Exp(B)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]red[/TD]
[TD](.194)[/TD]
[TD]1.522[/TD]
[TD]*[/TD]
[/TR]
[TR]
[TD]blue[/TD]
[TD](.088)[/TD]
[TD].897[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]black[/TD]
[TD](.078)[/TD]
[TD].787[/TD]
[TD]**[/TD]
[/TR]
[TR]
[TD]Constant[/TD]
[TD](.187)[/TD]
[TD].200[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Var[/TD]
[TD]S.E.[/TD]
[TD]Exp(B)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]red[/TD]
[TD](.195)[/TD]
[TD]1.518[/TD]
[TD]*[/TD]
[/TR]
[TR]
[TD]blue[/TD]
[TD](.092)[/TD]
[TD].917[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]green[/TD]
[TD](.079)[/TD]
[TD].779[/TD]
[TD]**[/TD]
[/TR]
[TR]
[TD]black[/TD]
[TD](.100)[/TD]
[TD].898[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Constant[/TD]
[TD](.191)[/TD]
[TD].215[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I would like to find a simple method to reformat these tables into a single table (variables, then EXP(B), then significance, and standard errors below EXP(B)) as follows:

[TABLE="width: 356"]
<tbody>[TR]
[TD]Var[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[TD="align: right"]2[/TD]
[TD][/TD]
[TD="align: right"]3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]red[/TD]
[TD]1.044[/TD]
[TD][/TD]
[TD]1.522[/TD]
[TD]*[/TD]
[TD]1.518[/TD]
[TD]*[/TD]
[/TR]
[TR]
[TD][/TD]
[TD](.137)[/TD]
[TD][/TD]
[TD](.194)[/TD]
[TD][/TD]
[TD](.195)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]blue[/TD]
[TD].936[/TD]
[TD][/TD]
[TD].897[/TD]
[TD][/TD]
[TD].917[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD](.141)[/TD]
[TD][/TD]
[TD](.088)[/TD]
[TD][/TD]
[TD](.092)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]green[/TD]
[TD]1.427[/TD]
[TD]*[/TD]
[TD]--[/TD]
[TD][/TD]
[TD].779[/TD]
[TD]**[/TD]
[/TR]
[TR]
[TD][/TD]
[TD](.150)[/TD]
[TD][/TD]
[TD]--[/TD]
[TD][/TD]
[TD](.079)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]black[/TD]
[TD]--[/TD]
[TD][/TD]
[TD].787[/TD]
[TD]**[/TD]
[TD].898[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]--[/TD]
[TD][/TD]
[TD](.078)[/TD]
[TD][/TD]
[TD](.100)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Constant[/TD]
[TD].195[/TD]
[TD][/TD]
[TD].200[/TD]
[TD][/TD]
[TD].215[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD](.197)[/TD]
[TD][/TD]
[TD](.187)[/TD]
[TD][/TD]
[TD](.191)[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


I can't seem to get my offset coding and logic correct for this, and would really appreciate it if someone could help me out. Any tips to keep the cell formatting using the offset command would be very helpful as well.

One caveat: There are a varied number of tables, and variables are not always ordered similarly. The final table always contains the correct variable order and full model, though. Therefore, I need for the structure of the model to be derived from the last model in the set. MickG helped me with a simpler version of this table previously: https://www.mrexcel.com/forum/excel...st-sorting-based-last-several-rows-sheet.html .

Thanks in advance to anyone who can help me out!
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
This code replicates the results you want, except for green and black. The columns that have '--' values in your original post are filled with the values in the next column. So instead of

[TABLE="class: cms_table, width: 356"]
<tbody>[TR]
[/TR]
[TR]
[TD]green[/TD]
[TD]1.427[/TD]
[TD]*[/TD]
[TD]--[/TD]
[TD][/TD]
[TD].779[/TD]
[TD]**[/TD]
[/TR]
[TR]
[TD][/TD]
[TD](.150)[/TD]
[TD][/TD]
[TD]--[/TD]
[TD][/TD]
[TD](.079)[/TD]
[/TR]
</tbody>[/TABLE]

it's
[TABLE="class: cms_table, width: 356"]
<tbody>[TR]
[/TR]
[TR]
[TD]green[/TD]
[TD]1.427[/TD]
[TD][/TD]
[TD].779[/TD]
[TD]**[/TD]
[/TR]
[TR]
[TD][/TD]
[TD](.150)[/TD]
[TD][/TD]
[TD](.079)[/TD]
[/TR]
</tbody>[/TABLE]


Not sure how big of a deal that is. Also, the code uses a class module so you'll need to create that as well.

Here is the main code. I have it looking at the sheet 'Original' where your data is. You'll need to change that part of the code to whatever the name of your sheet actually is. Also, it puts the results into a blank sheet called 'New'. So, you'll need a blank sheet for your results. You can name it new, or have a different name and adjust the code.

Code:
Sub Sort()
Dim Original As Worksheet 'Where your data is
Dim Output As Worksheet 'Blank sheet
Dim R As Range
Dim AR()
Dim dict As Object
Dim c As vColor
Dim i As Long


Set Original = Sheets("Original")
Set Output = Sheets("New")
Set dict = CreateObject("Scripting.Dictionary")
Set R = Original.UsedRange 'May need to change depending on what is in sheet
AR = R.value


For i = 1 To UBound(AR)
    If AR(i, 1) <> "Var" And AR(i, 1) <> "" Then
        If Not dict.Exists(AR(i, 1)) Then
            Set c = New vColor
            c.Name = AR(i, 1)
            c.ExpB = AR(i, 3) & " " & AR(i, 4)
            c.SE = AR(i, 2)
            dict.Add c.Name, c
        Else
            Set c = dict.Item(AR(i, 1))
            c.ExpB = AR(i, 3) & " " & AR(i, 4)
            c.SE = AR(i, 2)
        End If
    End If
Next i


Dim ro As Long
ro = 1


With Output
For Each v In dict.Items
    .Cells(ro, 1) = v.Name
    For i = 1 To v.Count
        v.Arg = i
        .Cells(ro, i + 1) = v.ExpB
        .Cells(ro + 1, i + 1) = v.SE
    Next i
    ro = ro + 2
Next v
End With


End Sub

Then you'll need to go to Insert-->Class Module. Then in the properties for the class, change the name to vColor. Then paste the following code.

Code:
Private SE_ As Collection
Private ExpB_ As Collection
Private Name_ As String
Private Arg_ As Integer


Private Sub Class_Initialize()
    Set ExpB_ = New Collection
    Set SE_ = New Collection
End Sub


Property Get Arg() As Integer
    Arg = Arg_
End Property


Property Let Arg(value As Integer)
    Arg_ = value
End Property


Function Count()
    Count = ExpB_.Count
End Function


Property Get SE() As Variant
    SE = SE_(Arg)
End Property


Property Let SE(value As Variant)
    SE_.Add value
End Property


Property Get ExpB() As Variant
    ExpB = ExpB_(Arg)
End Property


Property Let ExpB(value As Variant)
    ExpB_.Add value
End Property


Property Get Name() As String
    Name = Name_
End Property


Property Let Name(value As String)
    Name_ = value
End Property
 
Upvote 0
This code replicates the results you want, except for green and black. The columns that have '--' values in your original post are filled with the values in the next column. So instead of

[TABLE="class: cms_table, width: 356"]
<tbody>[TR]
[/TR]
[TR]
[TD]green[/TD]
[TD]1.427[/TD]
[TD]*[/TD]
[TD]--[/TD]
[TD][/TD]
[TD].779[/TD]
[TD]**[/TD]
[/TR]
[TR]
[TD][/TD]
[TD](.150)[/TD]
[TD][/TD]
[TD]--[/TD]
[TD][/TD]
[TD](.079)[/TD]
[/TR]
</tbody>[/TABLE]

it's
[TABLE="class: cms_table, width: 356"]
<tbody>[TR]
[/TR]
[TR]
[TD]green[/TD]
[TD]1.427[/TD]
[TD][/TD]
[TD].779[/TD]
[TD]**[/TD]
[/TR]
[TR]
[TD][/TD]
[TD](.150)[/TD]
[TD][/TD]
[TD](.079)[/TD]
[/TR]
</tbody>[/TABLE]


Not sure how big of a deal that is. Also, the code uses a class module so you'll need to create that as well.


[/CODE]

Thank you for spending time compiling this lrobbo314. Unfortunately, it's really important for the structure of the blanks to remain the same. This wasn't an approach I had thought about, and I'll definitely try to work through this code a little bit and see if I can adjust it to account for those. I'm wondering if I could find a way to prepopulate some of the blank spots with a filler to retain the structure.

Does anyone else have any other ideas that would produce a table that retains the integrity of the blanks in the tables? I get the sense that offset commands will produce what I'm looking for -- but I'm not quite sure how exactly it should look. I'm totally stumped on this one.
 
Upvote 0
You can retain the format if you make sure that every table has the same colors in it. So, go through each table and make sure that there is a row for Red, Blue, Green, Black, and Constant. Some tables are missing colors. So, you would add a row and then just have blank values for the other values. e.g. Black,"","",""
 
Upvote 0
You can retain the format if you make sure that every table has the same colors in it. So, go through each table and make sure that there is a row for Red, Blue, Green, Black, and Constant. Some tables are missing colors. So, you would add a row and then just have blank values for the other values. e.g. Black,"","",""

Thank you for the suggestion. Because the tables are produced automatically from SPSS, and have atypical formations and variables, I can't anticipate the models for each. I'm hoping that someone will be able to approach this similar to what MickG did in this link: https://www.mrexcel.com/forum/excel...st-sorting-based-last-several-rows-sheet.html . He used a series of R.Offset commands that may work for this and retain the structure. I produce the tables so that each of the final tables includes the complete model structure, and I'm thinking working from the bottom up with offsets is the key to solving this.
 
Upvote 0

Forum statistics

Threads
1,223,275
Messages
6,171,127
Members
452,381
Latest member
Nova88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top