Macro to line up tables based on cell content

L

leroy79

New Member
Joined
Feb 20, 2014
Messages
5
Hello, I am seeking assistance in writing a macro to help me line up data. The attached Excel file shows an example of what I have and what I want.

Columns A:C are from 2017. Columns D:F are from 2018, just pasted next to it. I have the same variables in each year (Variable1, Variable2, Variable3...) in the same order for each year.

The number of items in each table is not always the same. For example, 2017 Variable1 has "Yes". 2018 Variable1 has "Yes", "No". I want Variable2 to start on the same line.

I've searched many forums and found ways to line up individual rows, I'm not sure how to write the code so it will just line up that first row of the table. There are more than 100 tables, so inserting/deleting the rows manually isn't an option.

Thank you for your help!

[TABLE="width: 360"]
<tbody>[TR]
[TD]Have:[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]2017[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]2018[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Variable1[/TD]
[TD]Percent[/TD]
[TD][/TD]
[TD]Variable1[/TD]
[TD]Percent[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]100.00[/TD]
[TD][/TD]
[TD]Yes[/TD]
[TD]95.24[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]No[/TD]
[TD]4.76190476[/TD]
[/TR]
[TR]
[TD]Variable2[/TD]
[TD]Percent[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]0.28[/TD]
[TD][/TD]
[TD]Variable2[/TD]
[TD]Percent[/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD]99.72[/TD]
[TD][/TD]
[TD]Yes[/TD]
[TD]0.33[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]No[/TD]
[TD]94.9968334[/TD]
[/TR]
[TR]
[TD]Variable3[/TD]
[TD]Percent[/TD]
[TD][/TD]
[TD]Maybe[/TD]
[TD]5.14[/TD]
[/TR]
[TR]
[TD]Option 1[/TD]
[TD]0.56[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Option 2[/TD]
[TD]99.4357296[/TD]
[TD][/TD]
[TD]Variable3[/TD]
[TD]Percent[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Option 1[/TD]
[TD]0.46[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Option 2[/TD]
[TD]75.99[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Option 3[/TD]
[TD]20.69[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Option 4[/TD]
[TD]2.86[/TD]
[/TR]
[TR]
[TD]Want:[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]2017[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]2018[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Variable1[/TD]
[TD]Percent[/TD]
[TD][/TD]
[TD]Variable1[/TD]
[TD]Percent[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]100.00[/TD]
[TD][/TD]
[TD]Yes[/TD]
[TD]95.24[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]No[/TD]
[TD]4.76190476[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Variable2[/TD]
[TD]Percent[/TD]
[TD][/TD]
[TD]Variable2[/TD]
[TD]Percent[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]0.28[/TD]
[TD][/TD]
[TD]Yes[/TD]
[TD]0.33[/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD]99.72[/TD]
[TD][/TD]
[TD]No[/TD]
[TD]94.9968334[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Maybe[/TD]
[TD]5.14[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Variable3[/TD]
[TD]Percent[/TD]
[TD][/TD]
[TD]Variable3[/TD]
[TD]Percent[/TD]
[/TR]
[TR]
[TD]Option 1[/TD]
[TD]0.56[/TD]
[TD][/TD]
[TD]Option 1[/TD]
[TD]0.46[/TD]
[/TR]
[TR]
[TD]Option 2[/TD]
[TD]99.4357296[/TD]
[TD][/TD]
[TD]Option 2[/TD]
[TD]75.99[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Option 3[/TD]
[TD]20.69[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Option 4[/TD]
[TD]2.86[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sort by date Sort by votes
Try this for results on sheet2.
NB:- If you Data is actual "Tables" , you may need to convert to Range!!

Code: 
[COLOR=navy]Sub[/COLOR] MG09Jun01
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, Lst [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] R2 [COLOR=navy]As[/COLOR] Range, R1 [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] oMax [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] nRng [COLOR=navy]As[/COLOR] Range, Temp [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
    [COLOR=navy]Set[/COLOR] Rng = Range("D2", Range("D" & Rows.Count).End(xlUp))
        Lst = Rng.Count
    [COLOR=navy]Set[/COLOR] Rng = Rng.SpecialCells(xlCellTypeConstants)
        ReDim Ray(1 To Lst + 1, 1 To 6)
    [COLOR=navy]Set[/COLOR] nRng = Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
    c = 1
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] nRng.Areas
        Ray(1, 1) = nRng(1).Offset(-1).Value
            [COLOR=navy]If[/COLOR] Not .exists(Dn(1).Value) [COLOR=navy]Then[/COLOR]
                .Add Dn(1).Value, Dn
            [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] Dn
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng.Areas
        Ray(1, 4) = Rng(1).Offset(-1).Value
        
        [COLOR=navy]If[/COLOR] .exists(Dn(1).Value) [COLOR=navy]Then[/COLOR]
            Temp = c
            
            [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R2 [COLOR=navy]In[/COLOR] .Item(Dn(1).Value)
                c = c + 1
                Ray(c, 1) = R2: Ray(c, 2) = R2.Offset(, 1): Ray(c, 3) = R2.Offset(, 2)
            [COLOR=navy]Next[/COLOR] R2
            oMax = Application.Max(oMax, c)
                c = Temp
            [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R1 [COLOR=navy]In[/COLOR] Dn
                c = c + 1
                Ray(c, 4) = R1: Ray(c, 5) = R1.Offset(, 1): Ray(c, 6) = R1.Offset(, 2)
            [COLOR=navy]Next[/COLOR] R1
                oMax = Application.Max(oMax, c)
                c = oMax + 1
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] With

[COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c - 1, 6)
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Here's another approach...

Code: 
Sub AlignByHeaders()
 Dim bWrite1 As Boolean, bWrite2 As Boolean
 Dim lLastRow As Long, lNdxData1 As Long, lNdxData2 As Long, lNdxResult As Long
 Dim vData As Variant, vResult As Variant
 
 '--matching headers to align in columns 2 and 5
 Const sHEADER As String = "Percent"
 
 '--read data into array
 With ActiveSheet
   lLastRow = .Range("A:E").Find(What:="*", After:=Range("A1"), _
      SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
   vData = .Range("A1:E" & lLastRow)
 End With
 
 '--size results array
 ReDim vResult(1 To lLastRow * 2, 1 To 5)
 
 Do
   lNdxResult = lNdxResult + 1
   '--the row index gets incremented for each column unless
   '    the next row is Header for this col, but not the other side
   
   Select Case True
      Case vData(lNdxData1 + 1, 2) = sHEADER And vData(lNdxData2 + 1, 5) <> sHEADER
         bWrite1 = False: bWrite2 = True
      Case vData(lNdxData1 + 1, 2) <> sHEADER And vData(lNdxData2 + 1, 5) = sHEADER
         bWrite1 = True: bWrite2 = False
      Case Else
         bWrite1 = True: bWrite2 = True
   End Select

   '--write side 1
   If bWrite1 Then
      lNdxData1 = lNdxData1 + 1
      vResult(lNdxResult, 1) = vData(lNdxData1, 1)
      vResult(lNdxResult, 2) = vData(lNdxData1, 2)
   End If
   
   '--write 2
   If bWrite2 Then
      lNdxData2 = lNdxData2 + 1
      vResult(lNdxResult, 4) = vData(lNdxData2, 4)
      vResult(lNdxResult, 5) = vData(lNdxData2, 5)
   End If
 Loop While lNdxData1 < lLastRow And lNdxData2 < lLastRow
 
 With Sheets.Add
   .Cells(1).Resize(lNdxResult, UBound(vResult, 2)).Value = vResult
 End With
 
End Sub
 
Upvote 0
Thank you for your help, this works great! How would I modify the code if I need to include additional columns? For example:
[TABLE="width: 842"]
<colgroup><col><col span="5"><col><col span="5"></colgroup><tbody>[TR]
[TD]2017[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]2018[/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Variable1[/TD]
[TD]Percent[/TD]
[TD]Add'l Clmn3[/TD]
[TD]Add'l Clmn4[/TD]
[TD]Add'l Clmn5[/TD]
[TD] [/TD]
[TD]Variable1[/TD]
[TD]Percent[/TD]
[TD]Add'l Clmn3[/TD]
[TD]Add'l Clmn4[/TD]
[TD]Add'l Clmn5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD="align: right"]100[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Yes[/TD]
[TD="align: right"]95.24[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]No[/TD]
[TD="align: right"]4.7619[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Variable2[/TD]
[TD]Percent[/TD]
[TD]Add'l Clmn3[/TD]
[TD]Add'l Clmn4[/TD]
[TD]Add'l Clmn5[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD="align: right"]0.28[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Variable2[/TD]
[TD]Percent[/TD]
[TD]Add'l Clmn3[/TD]
[TD]Add'l Clmn4[/TD]
[TD]Add'l Clmn5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD="align: right"]99.72[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Yes[/TD]
[TD="align: right"]0.33[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]No[/TD]
[TD="align: right"]94.9968[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Variable3[/TD]
[TD]Percent[/TD]
[TD]Add'l Clmn3[/TD]
[TD]Add'l Clmn4[/TD]
[TD]Add'l Clmn5[/TD]
[TD] [/TD]
[TD]Maybe[/TD]
[TD="align: right"]5.14[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Option 1[/TD]
[TD="align: right"]0.56[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Option 2[/TD]
[TD="align: right"]99.4357[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Variable3[/TD]
[TD]Percent[/TD]
[TD]Add'l Clmn3[/TD]
[TD]Add'l Clmn4[/TD]
[TD]Add'l Clmn5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Option 1[/TD]
[TD="align: right"]0.46[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Option 2[/TD]
[TD="align: right"]75.99[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Option 3[/TD]
[TD="align: right"]20.69[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Option 4[/TD]
[TD="align: right"]2.86[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
I can't tell from your response whether you are using Mick's code or mine. FWIW, I've generalized the code I suggested earlier so it can be adapted for different numbers of columns and relative position of the header to be matched.

Code: 
Sub AlignByHeaders2()
 '--aligns two sets of adjacent columns by finding
 '    common column header for each group of rows

 Dim bWrite1 As Boolean, bWrite2 As Boolean
 Dim lLastRow As Long, lColCount As Long
 Dim lNdxCol, lNdxData1 As Long, lNdxData2 As Long, lNdxResult As Long
 Dim sTestSide1 As String, sTestSide2 As String
 Dim vData As Variant, vResult As Variant
 
 '--modify these variables based on layout
 Const sHEADER As String = "Percent"
 Const lCOL_PER_SIDE As Long = 6   'Column count per side
 Const lMATCH_COL As Long = 2 'Column Number to find sHeader for each side
 
 lColCount = lCOL_PER_SIDE * 2
 
 '--read data into array
 With ActiveSheet
   lLastRow = .Range("A:A").Resize(, lColCount).Find( _
      What:="*", After:=Range("A1"), _
      SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
   vData = .Range("A1").Resize(lLastRow, lColCount)
 End With
 
 '--size results array
 ReDim vResult(1 To lLastRow * 2, 1 To lColCount)
 
 Do
   lNdxResult = lNdxResult + 1
   
   '--read values from each side to be compared to sHeader
   sTestSide1 = vData(lNdxData1 + 1, lMATCH_COL)
   sTestSide2 = vData(lNdxData2 + 1, lMATCH_COL + lCOL_PER_SIDE)
      
   Select Case True
      '--the row index gets incremented for each column unless
      '    the next row is Header for this col, but not the other side
      Case sTestSide1 = sHEADER And sTestSide2 <> sHEADER
         bWrite1 = False: bWrite2 = True
      Case sTestSide1 <> sHEADER And sTestSide2 = sHEADER
         bWrite1 = True: bWrite2 = False
      Case Else
         bWrite1 = True: bWrite2 = True
   End Select

   '--write side 1
   If bWrite1 Then
      lNdxData1 = lNdxData1 + 1
      For lNdxCol = 1 To lCOL_PER_SIDE
         vResult(lNdxResult, lNdxCol) = vData(lNdxData1, lNdxCol)
      Next lNdxCol
   End If
   
   '--write 2
   If bWrite2 Then
      lNdxData2 = lNdxData2 + 1
      For lNdxCol = lCOL_PER_SIDE + 1 To lColCount
         vResult(lNdxResult, lNdxCol) = _
            vData(lNdxData2, lNdxCol)
      Next lNdxCol
   End If
   
 Loop While lNdxData1 < lLastRow And lNdxData2 < lLastRow
 
 With Sheets.Add
   .Cells(1).Resize(lNdxResult, UBound(vResult, 2)).Value = vResult
 End With
 
End Sub
 
Upvote 0
Hi Jerry, Thank you very much for your help! I apologize for not specifying which method I was using (I was using yours). This has been extremely helpful!

If I can ask here, is there a way to add a simple boarder around each variable and data below it?

Thanks!
 
Upvote 0
You must log in or register to reply here.

Similar threads

Y
  • Question Question
Copy subsequent row to same row based on multiple condition
Replies
2
Views
680
sheetspread
S
S
  • Question Question
Speed up Pivot Table Macro : Help needed
Replies
0
Views
2K
suhas_shah
S

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

Share this page

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