Macro to Move Data Within Rows Based on Criteria

[Michael151]

Hello all,

Just need a little help completing a macro that will move data on several rows if different criteria is met. The macro listed below will move the dates in HB Start Date and HB End Date into Start Date and End Date columns if two sequential titles match. What I’d like to add is the criteria if the Deal ID AND Title match, then move dates.

In the example below, Title 2 will move the dates over since the titles match and the Deal IDs match. Title 3 however, will not move, because the Deal IDs don’t match.


Before:
<table border="0" cellpadding="0" cellspacing="0" width="512"><col style="width: 48pt;" width="64" span="8"> <tbody><tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt; width: 48pt;" width="64" height="17">Deal ID</td> <td style="width: 48pt;" width="64">Title</td> <td style="width: 48pt;" width="64">Hdate</td> <td style="width: 48pt;" width="64">HB Start Date</td> <td style="width: 48pt;" width="64">HB End Date</td> <td style="width: 48pt;" width="64">Start Date</td> <td style="width: 48pt;" width="64">End Date</td> <td style="width: 48pt;" width="64">Gdate</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">
</td> <td>Title1</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td>
</td> <td>
</td> <td class="xl24">Date1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Deal 10</td> <td>Title2</td> <td class="xl24">
</td> <td class="xl24">Date1</td> <td class="xl24">Date2</td> <td>
</td> <td>
</td> <td class="xl24">Date1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Deal 10</td> <td>Title2</td> <td class="xl24">
</td> <td class="xl24">Date1</td> <td class="xl24">Date2</td> <td>
</td> <td>
</td> <td class="xl24">Date1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Deal 11</td> <td>Title3</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td>
</td> <td>
</td> <td class="xl24">Date1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Deal12</td> <td>Title3</td> <td class="xl24">
</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td>
</td> <td>
</td> <td class="xl24">Date1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">
</td> <td>Title4</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td>
</td> <td>
</td> <td class="xl24">Date1</td> </tr> </tbody></table>
After:
<table border="0" cellpadding="0" cellspacing="0" width="512" height="162"><col style="width: 48pt;" width="64" span="8"> <tbody><tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt; width: 48pt;" width="64" height="17">Deal ID</td> <td style="width: 48pt;" width="64">Title</td> <td style="width: 48pt;" width="64">Hdate</td> <td style="width: 48pt;" width="64">HB Start Date</td> <td style="width: 48pt;" width="64">HB End Date</td> <td style="width: 48pt;" width="64">Start Date</td> <td style="width: 48pt;" width="64">End Date</td> <td style="width: 48pt;" width="64">Gdate</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">
</td> <td>Title1</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td>
</td> <td>
</td> <td class="xl24">Date1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Deal 10</td> <td>Title2</td> <td class="xl24">
</td> <td class="xl24">Date1</td> <td class="xl24">Date2</td> <td class="xl24">Date1</td> <td class="xl24">Date2</td> <td class="xl24">
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Deal 10</td> <td>Title2</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td class="xl24">Date2</td> <td class="xl24">Date1</td> <td class="xl24">Date2</td> <td class="xl24">
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Deal 11</td> <td>Title3</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td>
</td> <td>
</td> <td class="xl24">Date1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Deal12</td> <td>Title3</td> <td class="xl24">
</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td>
</td> <td>
</td> <td class="xl24">Date1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">
</td> <td>Title4</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td class="xl24">Date1</td> <td>
</td> <td>
</td> <td class="xl24">Date1
</td> </tr> </tbody></table>

<!--[if gte mso 9]><xml>  <w:WordDocument>   <w:View>Normal</w:View>   <w:Zoom>0</w:Zoom>   <w:Compatibility>    <w:BreakWrappedTables/>    <w:SnapToGridInCell/>    <w:WrapTextWithPunct/>    <w:UseAsianBreakRules/>   </w:Compatibility>   <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel>  </w:WordDocument> </xml><![endif]--><!--[if gte mso 10]> <style>  /* Style Definitions */  table.MsoNormalTable     {mso-style-name:"Table Normal";     mso-tstyle-rowband-size:0;     mso-tstyle-colband-size:0;     mso-style-noshow:yes;     mso-style-parent:"";     mso-padding-alt:0in 5.4pt 0in 5.4pt;     mso-para-margin:0in;     mso-para-margin-bottom:.0001pt;     mso-pagination:widow-orphan;     font-size:10.0pt;     font-family:"Times New Roman";} </style> <![endif]-->  
Sub test()
    Dim iTitlerow As Long, iTitlecol As Integer, iHBStartDatecol As Integer
    Dim iHBEndDatecol As Integer, iStartDatecol As Integer, iEndDatecol As Integer
    Dim iGDate As Long, iHDate As Long
    Dim cell As Range, myrange As Range
    
    Application.ScreenUpdating = False
    
    On Error GoTo Err_Handler
    With ActiveSheet
        iTitlerow = .UsedRange.Find("Title", , xlValues, xlWhole).Row
        iTitlecol = .UsedRange.Find("Title").Column
        iHBStartDatecol = .UsedRange.Find("HB Start Date").Column
        iHBEndDatecol = .UsedRange.Find("HB End Date").Column
        iStartDatecol = .UsedRange.Find("Start Date").Column
        iEndDatecol = .UsedRange.Find("End Date").Column
        Set myrange = .Range(.Cells(iTitlerow + 1, iTitlecol), .Cells(iTitlerow, iTitlecol).End(xlDown))
        iHDate = .UsedRange.Find("Hdate").Column
        iGDate = .UsedRange.Find("Gdate").Column
    End With
    On Error GoTo 0
       
    For Each cell In myrange
    
        With cell
   [COLOR=Black]     If .Offset(1).Value = .Value [/COLOR][COLOR=Black]And _
[/COLOR] [COLOR=Black]           .Offset(2).Value <> .Value And _
[/COLOR] [COLOR=Black]           .Offset(-1).Value <> .Value Then[/COLOR]
           
            If Not IsEmpty(Cells(.Row, iHBStartDatecol)) Then
                  Cells(.Row, iStartDatecol) = Cells(.Row, iHBStartDatecol)
                  Cells(.Row, iEndDatecol) = Cells(.Row, iHBEndDatecol)
                  Cells(.Row, iHDate).ClearContents
                  Cells(.Row, iGDate).ClearContents
            End If
            
            With .Offset(1)
            If Not IsEmpty(Cells(.Row, iHBStartDatecol)) Then
                  Cells(.Row, iStartDatecol) = Cells(.Row, iHBStartDatecol)
                  Cells(.Row, iEndDatecol) = Cells(.Row, iHBEndDatecol)
                  Cells(.Row, iGDate).ClearContents
            
                
    End If: End With: End If: End With: Next cell
    
    Application.ScreenUpdating = True
    MsgBox "Update Complete"
    Exit Sub
    
Err_Handler:
    Application.ScreenUpdating = True
    MsgBox "Couldn't define the range."
    
End Sub

Deal ID is not always in the first column, which is why I'd like to use the header in row 1 to identify.

Help is appreciated!

 

[Michael151]

Problem as been solved - post closed.