Please help with VBA code for list sorting based on last several rows in sheet

[liz123]

Hi everyone,


I’m a longtime lurker, and first time poster. I really appreciate the detailed info shared here. This forum has helped me tremendously with several projects.


I apologize if this is too complicated of a request, but I just don’t seem to be able to put together something that works as automatically as I’d like, so I was hoping someone more knowledgeable might help out with some specific VBA code.


I have a bunch of files with a series of logistic regression models separated by two blank rows. Each model is headed with “var” and “Exp(B)” and contains markers of significance in a third column. I would like to condense all this info into a list with several columns representing each model (see below for example). In each file, the bottom-most model has the full set of variables (this is somewhere between 6 and 22 variables). My goal is to create a chart using the bottom-most model as a guide for all available variables, and then automatically transfer the values and significance marks into columns to the right in order of the models. I’m okay with this being in the same sheet or a new sheet.


For example, if I have a file with:


[TABLE="width: 500"]
<tbody>[TR]
[TD]Var[/TD]
[TD]Exp(B)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]yellow[/TD]
[TD].34[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]green[/TD]
[TD].45[/TD]
[TD]*[/TD]
[/TR]
[TR]
[TD]blue[/TD]
[TD].82[/TD]
[TD]**[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Var[/TD]
[TD]Exp(B)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]yellow[/TD]
[TD].34[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]green[/TD]
[TD].44[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]orange[/TD]
[TD].65[/TD]
[TD]**[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Var[/TD]
[TD]Exp(B)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]yellow[/TD]
[TD].43[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]green[/TD]
[TD].56[/TD]
[TD]*[/TD]
[/TR]
[TR]
[TD]blue[/TD]
[TD].56[/TD]
[TD]*[/TD]
[/TR]
[TR]
[TD]orange[/TD]
[TD].45[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

—


I’d like to convert it to:

[TABLE="width: 500"]
<tbody>[TR]
[TD]var[/TD]
[TD]1[/TD]
[TD][/TD]
[TD]2[/TD]
[TD][/TD]
[TD]3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]yellow[/TD]
[TD].34[/TD]
[TD][/TD]
[TD].34[/TD]
[TD][/TD]
[TD].43[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]green[/TD]
[TD].45[/TD]
[TD]*[/TD]
[TD].44[/TD]
[TD][/TD]
[TD].56[/TD]
[TD]*[/TD]
[/TR]
[TR]
[TD]blue[/TD]
[TD].82[/TD]
[TD]**[/TD]
[TD]--[/TD]
[TD][/TD]
[TD].56[/TD]
[TD]*[/TD]
[/TR]
[TR]
[TD]orange[/TD]
[TD]--[/TD]
[TD][/TD]
[TD].65[/TD]
[TD]**[/TD]
[TD].45[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



If anyone could help me out in writing something systematic and flexible code that allows the final model to shape the list regardless of the number of variables it contains, I’d really really really appreciate it!!!

 

[MickG]

Try this for results starting "D1"

[COLOR="Navy"]Sub[/COLOR] MG27Aug59
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] p [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] V [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A:A").SpecialCells(xlCellTypeConstants, 2)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
n = Rng.Areas.Count
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Areas(n)
    [COLOR="Navy"]If[/COLOR] Not Dn.Address = Rng.Areas(n)(1).Address [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            .Add (Dn.Value), .Count
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
ReDim Ray(1 To .Count + 2, 1 To n * .Count)
Ray(1, 1) = "VAR"
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Areas
    Ac = Ac + 2: V = V + 1
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dn
            [COLOR="Navy"]If[/COLOR] .exists(R.Value) [COLOR="Navy"]Then[/COLOR]
                Ray(1, Ac) = V
                Ray(.Item(R.Value) + 2, 1) = R
                Ray(.Item(R.Value) + 2, Ac) = R.Offset(, 1)
                Ray(.Item(R.Value) + 2, Ac + 1) = R.Offset(, 2)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] Dn
Range("D1").Resize(.Count + 1, Ac + 1).Value = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[liz123]

Thank you so much MickG!!!! This worked perfectly for my needs.

I really really appreciate your help! You just saved me sooo much work.

 

[MickG]

You're very welcome.