VBA Consolidate Headers to 1 Column

[Stephen_IV]

Good afternoon,

I have data that is pulled from a program that has different headers but those headers are alike. For example Bereavement Immed and Bereave Near Relativ they are one in same. I need to sum and consolidate those to 1 field. Personal w/Approval and Personal W/OApproval are one in the same so I would need to sum and consolidate into 1 field. Please see below.

<style type="text/css">
table.tableizer-table {
font-size: 12px;
border: 1px solid #CCC ;
font-family: Arial, Helvetica, sans-serif;
}
.tableizer-table td {
padding: 4px;
margin: 3px;
border: 1px solid #CCC ;
}
.tableizer-table th {
background-color: #104E8B ;
color: #FFF ;
font-weight: bold;
}
</style>
<table class="tableizer-table">
<thead><tr class="tableizer-firstrow"><th>SCHOOL</th><th>Bereavement Immed</th><th>Bereave Near Relativ</th><th>Personal w/Approval</th><th>Personal W/OApproval</th><th>Sick Cert > FMLA</th><th>Sick Cert > FMLA (Maternity)</th></tr></thead><tbody>
<tr><td>School A</td><td>0</td><td>2</td><td>1</td><td>1</td><td>0</td><td>0</td></tr>
<tr><td>School B</td><td>5</td><td>1</td><td>14</td><td>3</td><td>0</td><td>0</td></tr>
<tr><td>School C</td><td>0</td><td>2</td><td>4</td><td>3</td><td>0</td><td>0</td></tr>
<tr><td>School D</td><td>0</td><td>0</td><td>10</td><td>3</td><td>0</td><td>0</td></tr>
<tr><td>School E</td><td>0</td><td>0</td><td>5</td><td>2</td><td>0</td><td>0</td></tr>
<tr><td>School F</td><td>2</td><td>1</td><td>2</td><td>3</td><td>30</td><td>0</td></tr>
<tr><td>School G</td><td>0</td><td>0</td><td>5</td><td>2</td><td>0</td><td>0</td></tr>
<tr><td>School H</td><td>0</td><td>0</td><td>6</td><td>3</td><td>19</td><td>0</td></tr>
<tr><td>School I</td><td>1</td><td>0</td><td>9</td><td>2</td><td>0</td><td>21</td></tr>
</tbody></table>


To this:


<style type="text/css">
table.tableizer-table {
font-size: 12px;
border: 1px solid #CCC ;
font-family: Arial, Helvetica, sans-serif;
}
.tableizer-table td {
padding: 4px;
margin: 3px;
border: 1px solid #CCC ;
}
.tableizer-table th {
background-color: #104E8B ;
color: #FFF ;
font-weight: bold;
}
</style>
<table class="tableizer-table">
<thead><tr class="tableizer-firstrow"><th>SCHOOL</th><th>Bereavement Immed</th><th>Personal w/Approval</th><th>Sick Cert > FMLA</th></tr></thead><tbody>
<tr><td>School A</td><td>2</td><td>2</td><td>0</td></tr>
<tr><td>School B</td><td>6</td><td>17</td><td>0</td></tr>
<tr><td>School C</td><td>2</td><td>7</td><td>0</td></tr>
<tr><td>School D</td><td>0</td><td>13</td><td>0</td></tr>
<tr><td>School E</td><td>0</td><td>7</td><td>0</td></tr>
<tr><td>School F</td><td>3</td><td>5</td><td>30</td></tr>
<tr><td>School G</td><td>0</td><td>7</td><td>0</td></tr>
<tr><td>School H</td><td>0</td><td>9</td><td>19</td></tr>
<tr><td>School I</td><td>1</td><td>11</td><td>21</td></tr>
</tbody></table>

Any help would be appreciated!!

 

[mumps]

Are the "like" headers always beside each other? Are the header names always the same as in your posted examples?

 

[Stephen_IV]

Hi mumps! They are not always together but if it makes it easier then I can move them next to each other.

 

[mumps]

If you place them together then this should work:

Sub joinCols()
    Application.ScreenUpdating = False
    Dim LastRow As Long, lCol As Long, x As Long, rng As Range
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    For x = 2 To lCol Step 2
        For Each rng In Range(Cells(2, x), Cells(LastRow, x))
            rng = rng + rng.Offset(0, 1)
        Next rng
    Next x
    For x = lCol To 3 Step -2
        Columns(x).Delete
    Next x
    Application.ScreenUpdating = True
End Sub

 

[Stephen_IV]

mumps! Works great!! Thank you so much! This problem has been lingering for a while so thank you for helping me sort this out!!!

 

[mumps]

You are very welcome.