Super Stuck - Combining Horizontal Sets of Data into One Vertical Table

[rdetreville]

Hello! First of all, I would like to say this website has been my saving grace for years. I'm so happy it exists and have learned so very much from members of this forum for years now.

This is my first official post. I'm under the gun to finish a tool for my job and am at a brick wall.

I'm creating a report generation tool that grabs data from hundreds of separate workbooks on a server and merges them into one. I have been successful so far and my data is now aligned on one worksheet and I have written all sorts of macros to clean up and scrub the data. What I'm left with now is basically repeating types of data (tables almost) going horizontally across the worksheet, with the same column headers: "Tracker Name" , "Team Member" , and then Month-Year columns: "May-2015", "June-2015", etc. I've attached a picture if this helps. All sets of data start with the "Tracker Name" and "Team Member" column and all begin with the same month but have different amounts of months after the first month column (some more, some less). All clusters are separated by a blank column.

I've now got to get the data into one big vertical table, so that I can create a PivotTable and actually use the data. I'm so close!

I've brainstormed countless ways to make this happen, and have come close with some methods, but am still stuck.

The primary way I've been attempting was to loop through the header row, find every instance of "Tracker Name" (the first column for each cluster) and then use the "ActiveCell.CurrentRegion.Select" feature to grab each "table" and actually turn it into a table. Then I was thinking I could delete all data not in a table and then somehow "stack" all the tables on top of each other on a new worksheet, all alligning in Column 1, and then turn all the tables back to ranges, remove the duplicate headers. But when I have tried various methods to find each cluster, and then select the current region, it messes up my being able to find the next cluster

Example code:

Sub govert2()

Dim lColumn As Long
Dim iCntr As Long
Dim myrange As Range

lColumn = 10000
For iCntr = lColumn To 1 Step -1
    
    If Cells(1, iCntr).Value = "Tracker Name" Then ActiveCell.Select
      
    If Cells(1, iCntr).Value = "Tracker Name" Then ActiveCell.CurrentRegion.Select
    
    If Cells(1, iCntr).Value = "Tracker Name" Then ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = “Table2”
    
    Next

End Sub

I can see the data I need right in front of me! I just need to "stack" these columns on top of each other. A picture of my data is below. If anyone could help, I would be most appreciative. Thanks!!!

Richard

 

[rdetreville]

To add - I am using Excel 2010 and Windows 7. Thanks!

 

[AlphaFrog]

Hi and welcome to the forum.

Try this...

[color=darkblue]Sub[/color] govert2()
    
    [color=darkblue]Dim[/color] Found [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FirstFound [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] ws [color=darkblue]As[/color] Worksheet
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]Set[/color] ws = ActiveSheet
    Sheets.Add After:=ActiveSheet
    
    [color=darkblue]Set[/color] Found = ws.Rows(1).Find("Tracker Name", , , xlWhole, 1, 1, 0)
    
    [color=darkblue]If[/color] [color=darkblue]Not[/color] Found [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
        FirstFound = Found.Address
        Found.CurrentRegion.Copy Destination:=Range("A1")
        [color=darkblue]Do[/color]
            [color=darkblue]Set[/color] Found = ws.Rows(1).FindNext(After:=Found)
            Found.CurrentRegion.Offset(1).Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
        [color=darkblue]Loop[/color] [color=darkblue]Until[/color] Found.Address = FirstFound
    [color=darkblue]Else[/color]
        MsgBox "Cannot find header ""Tracker Name""."
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[rdetreville]

Hi and welcome to the forum.

Try this...

[COLOR=darkblue]Sub[/COLOR] govert2()
    
    [COLOR=darkblue]Dim[/COLOR] Found [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] FirstFound [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]Set[/COLOR] ws = ActiveSheet
    Sheets.Add After:=ActiveSheet
    
    [COLOR=darkblue]Set[/COLOR] Found = ws.Rows(1).Find("Tracker Name", , , xlWhole, 1, 1, 0)
    
    [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Found [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
        FirstFound = Found.Address
        Found.CurrentRegion.Copy Destination:=Range("A1")
        [COLOR=darkblue]Do[/COLOR]
            [COLOR=darkblue]Set[/COLOR] Found = ws.Rows(1).FindNext(After:=Found)
            Found.CurrentRegion.Offset(1).Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
        [COLOR=darkblue]Loop[/COLOR] [COLOR=darkblue]Until[/COLOR] Found.Address = FirstFound
    [COLOR=darkblue]Else[/COLOR]
        MsgBox "Cannot find header ""Tracker Name""."
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

AlphaFrog - my mind is blown!! It looks like your code may have solved the problem, instantly. I'm still checking to make sure the data it stacked in the correct form with no errors, but it seems so far like your code may have worked!

One thing I've noticed though is that it seems to have pulled from the first available block of data, which only ran from May-2015 through May-2016. Some of the other data sets go out a big farther, so when I scroll down those stick out with no header above. I could probably just add those back in though.

I'm going to carefully go through your formula step by step and audit what it's doing, but is there any way you could explain in layman terms what it did?

To confirm what I think it did - it looked at the first row, found the first set of headers (up until a blank), copied that to a new sheet? And then went back through the first row and looked for any columns with those headers and copied those entire rows down under the new headers in row 1 on the new sheet? I just want to make sure all data rows stayed aligned from the original sheet and that values haven't shifted or been copied over others (since columns in each data set have different lengths. But overall - this was brilliant! I didn't think it would be so simple! You are a magician!

I'm so close to getting this data into a useable format! One other thing to note, my blocks of data each came from a worksheet template (well, several sets of templates - which is why I've had to use so many codes to clean the data) and there is an unneeded table of data appended after a blank row or two on every single column. Is there a simple code I could run before I use the code you provided above, that would look through each column, find the first blank row, and delete/clear (but not shift) any unneeded data after that blank row? Then I could run your code and it would be in much better shape.

Also a thought for your code - though this may not be the most practical way - could I have all possible column headers pre-programmed into the code from the beginning and just have the system place those automatically on the first row on the new sheet, and then look back on the original sheet for any columns that fall under those headers? Then I could have it delete any columns that have a numerical value of zero or are blank. Or - would it be easiest if I added a code before your code that pasted all needed column headers in the first block (with proper spacing) and then from there ran your code?

Many thanks! I'm going to try some codes and will report back!

Richard

 

[rdetreville]

Another thing to note: though the Month column headers all seem to be the same due to a conditional formatting based on value code I wrote, they're not when you actually look at the integer form. (see picture below). Is this impeding the code you wrote at all? I was thinking maybe I could have a macro convert all data in the first row into absolute text - there's a formula for that which I kind of recall is TEXT(something). Does this need to happen?

 

[rdetreville]

Ok - I stepped through your macro and see exactly what it's doing! It's awesome - it does exactly what I was asking for in the original post. It copies the "Found.CurrentRegion" of each block exactly - so it doesn't look like it's grabbing any of the unneeded tables below. I may still try to create a quick macro that looks down all columns and clears any data after the first blank row found - just to be safe since there could potentially be weird data that makes the "Found.CurrentRegion" feature not work quite right.

So yes, I'm going to append a tiny bit to the beginning of your macro to have the system dump in the longest possible number of months into the columns before the actual data - so your code will pull those months as the prerequisite.

But this is great!!

 

[rdetreville]

AlphaFrog - I have figured out everything I need! Thank you!!!

There does seem to be one tiny issue with your macro however - on my new sheet, the first Found.CurrentRegion that is pasted onto the new worksheet is duplicated again at the very end. Just that one block of data. Is there a small tweak I might make to ensure it doesn't duplicate it again at the end?

Thanks!

 

[AlphaFrog]

You're welcome. Thanks for the feedback.

There was a flaw in my original code. It duplicated the first data block at the bottom of the data set. The new version below corrects that. And it also copies the headers from the Tracker Name block that has the most number of headers.

[color=darkblue]Sub[/color] govert2()
    
    [color=darkblue]Dim[/color] Found [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FirstFound [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] ws [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] rngHeaders [color=darkblue]As[/color] Range
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]Set[/color] ws = ActiveSheet
    Sheets.Add After:=ActiveSheet
    
    [color=darkblue]Set[/color] Found = ws.Rows(1).Find("Tracker Name", , , xlWhole, 1, 1, 0)
    
    [color=darkblue]If[/color] [color=darkblue]Not[/color] Found [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
        FirstFound = Found.Address
        [color=darkblue]Set[/color] rngHeaders = Found
        [color=darkblue]Do[/color]
            [color=darkblue]With[/color] Found.CurrentRegion
                .Offset(1).Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
                [color=darkblue]If[/color] rngHeaders.Count < .Rows(1).Cells.Count [color=darkblue]Then[/color] [color=darkblue]Set[/color] rngHeaders = .Rows(1).Cells
            [color=darkblue]End[/color] [color=darkblue]With[/color]
            [color=darkblue]Set[/color] Found = ws.Rows(1).FindNext(After:=Found)
        [color=darkblue]Loop[/color] [color=darkblue]Until[/color] Found.Address = FirstFound
        rngHeaders.Copy Destination:=Range("A1")
    [color=darkblue]Else[/color]
        MsgBox "Cannot find header ""Tracker Name""."
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

This cleans each column below the first empty cell in each column.

[color=darkblue]Sub[/color] Clean_Columns()
    [color=darkblue]Dim[/color] LastCol [color=darkblue]As[/color] [color=darkblue]Long[/color], i [color=darkblue]As[/color] Long
    LastCol = Cells.Find("*", , , , 2, 2).Column
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] LastCol
        [color=darkblue]If[/color] Cells(1, i) <> "" [color=darkblue]Then[/color]
            Range(Cells(1, i).End(xlDown).Offset(1).Cells, _
                Cells(Rows.Count, i).End(xlUp).Offset(1)).ClearContents
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] i
    Application.ScreenUpdating = [color=darkblue]True[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[rdetreville]

AlphaFrog - Thanks for this revised code! I thought we were home free, but did a tiny audit, and see there is still a small problem. Some of the Found.CurrentRegion areas selected sometimes have a straggler row or two of data that do not have information in the "Tracker Name" column, but are sometimes selected when the CurrentRegion selection is made. When the macro copies this data into the new vertical sheet, it seems to be looking at the very bottom of the "Found" CurrentRegion that was pasted above it and it is messing up the data.

None of these extra mess rows have data in the "Tracker Name" column. Is there some trick we can do here? Some way to delete those unneeded rows? OR - When the data is pasted in the new vertical sheet, can it just find the next blank row in Column A? That would take care of the problem - it would paste over the junk rows we do not need.

See picture for reference. Thank you so very much for your help. I'm so close!!

 

[AlphaFrog]

OR - When the data is pasted in the new vertical sheet, can it just find the next blank row in Column A? That would take care of the problem - it would paste over the junk rows we do not need.

The code currently does find the next blank cell in column A with this line.
.Offset(1).Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)

Are you sure that the column A cell in the straggler rows is truly blank? It may have unseen space character(s) in it. Which makes it not truly blank.