Help Modifying VBA Code Blank Cells

M

Michael151

Board Regular
Joined
Sep 20, 2010
Messages
247
Hello all,

Just need a little help modifying my code for a macro. I’d like the macro to only perform the function (in this case moving info between cells) if the cell contains text. If the cell is blank, don’t move or do anything. The code below allows me to move the dates in HBStartDate and HBEndDate into the Start Date and End Date columns if two sequential titles match – in this case, Title2 in the example below. However, if the cells in HBStartDate and HBEndDate are blank, it will move the blank cells into Start Date and End Date, erasing the text (if any that is already there).

If there is anyway to write in a section of the code that says something like IF “*” or blank cell is found, then do not move dates.

Help is appreciated – thank you!


Before:



<table border="0" cellpadding="0" cellspacing="0" width="377"><col style="width: 48pt;" width="64"> <col style="width: 65pt;" width="86"> <col style="width: 53pt;" width="70"> <col style="width: 70pt;" width="93"> <col style="width: 48pt;" width="64"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl24" style="height: 12.75pt; width: 48pt;" width="64" height="17">Title</td> <td class="xl24" style="width: 65pt;" width="86">HB Start Date</td> <td class="xl24" style="width: 53pt;" width="70">HB End Date</td> <td class="xl24" style="width: 70pt;" width="93">Start Date</td> <td class="xl24" style="width: 48pt;" width="64">End Date</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title1</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>date1</td> <td>date2</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>date1</td> <td>date2</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">
</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> </tbody></table>After:

<table border="0" cellpadding="0" cellspacing="0" width="377"><col style="width: 48pt;" width="64"> <col style="width: 65pt;" width="86"> <col style="width: 53pt;" width="70"> <col style="width: 70pt;" width="93"> <col style="width: 48pt;" width="64"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl24" style="height: 12.75pt; width: 48pt;" width="64" height="17">Title</td> <td class="xl24" style="width: 65pt;" width="86">HB Start Date</td> <td class="xl24" style="width: 53pt;" width="70">HB End Date</td> <td class="xl24" style="width: 70pt;" width="93">Start Date</td> <td class="xl24" style="width: 48pt;" width="64">End Date</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title1</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>date1</td> <td>date2</td> <td>date1</td> <td>date2</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>date1</td> <td>date2</td> <td>date1</td> <td>date2</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> </tbody></table>
Code:

Option Explicit
Sub test()
Dim iTitlerow As Long, iTitlecol As Integer, iHBStartDatecol As Integer, iHBEndDatecol As Integer, iStartDatecol As Integer, _
iEndDatecol As Integer, myrange, i As Long, x As Integer, y As Integer
With ActiveSheet: On Error Resume Next: Application.ScreenUpdating = False
iTitlerow = .UsedRange.Find("Title", , xlValues, xlWhole).Row: iTitlecol = .UsedRange.Find("Title", , xlValues, xlWhole).Column
iHBStartDatecol = .UsedRange.Find("HB Start Date", , xlValues, xlWhole).Column
iHBEndDatecol = .UsedRange.Find("HB End Date", , xlValues, xlWhole).Column
iStartDatecol = .UsedRange.Find("Start Date", , xlValues, xlWhole).Column
iEndDatecol = .UsedRange.Find("End Date", , xlValues, xlWhole).Column
Set myrange = Range(.Cells(iTitlerow, iTitlecol), .Cells(iTitlerow, iTitlecol).End(xlDown))
If Not myrange Is Nothing Then
For i = 2 To myrange.Cells.Count
If myrange(i).Offset(1, 0).Value = myrange(i).Value Then x = 1
If myrange(i).Offset(2, 0) = myrange(i).Value Then y = 1
If x = 1 And y = 0 Then
.Cells(myrange(i).Row, iStartDatecol) = .Cells(myrange(i).Row, iHBStartDatecol)
.Cells(myrange(i).Row, iEndDatecol) = .Cells(myrange(i).Row, iHBEndDatecol)

End If
Next
End If
End With
End Sub


Problem:
Before:

<table border="0" cellpadding="0" cellspacing="0" width="377"><col style="width: 48pt;" width="64"> <col style="width: 65pt;" width="86"> <col style="width: 53pt;" width="70"> <col style="width: 70pt;" width="93"> <col style="width: 48pt;" width="64"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl24" style="height: 12.75pt; width: 48pt;" width="64" height="17">Title</td> <td class="xl24" style="width: 65pt;" width="86">HB Start Date</td> <td class="xl24" style="width: 53pt;" width="70">HB End Date</td> <td class="xl24" style="width: 70pt;" width="93">Start Date</td> <td class="xl24" style="width: 48pt;" width="64">End Date</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title1</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>
</td> <td>
</td> <td>DateY</td> <td>DateK</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>
</td> <td>
</td> <td>DateG</td> <td>DateM</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> </tbody></table>
After:

<table border="0" cellpadding="0" cellspacing="0" width="377"><col style="width: 48pt;" width="64"> <col style="width: 65pt;" width="86"> <col style="width: 53pt;" width="70"> <col style="width: 70pt;" width="93"> <col style="width: 48pt;" width="64"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl24" style="height: 12.75pt; width: 48pt;" width="64" height="17">Title</td> <td class="xl24" style="width: 65pt;" width="86">HB Start Date</td> <td class="xl24" style="width: 53pt;" width="70">HB End Date</td> <td class="xl24" style="width: 70pt;" width="93">Start Date</td> <td class="xl24" style="width: 48pt;" width="64">End Date</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title1</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> </tr> </tbody></table>
Macro will bring blank cells over into Start and End Date columns, erasing data that is already there. If cell is empty in HBStartDate and HBEndDate columns, then do not move blank cells.

Thanks!
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Sort by date Sort by votes
Code: 
Sub test()
    Dim iTitlerow As Long, iTitlecol As Integer, iHBStartDatecol As Integer
    Dim iHBEndDatecol As Integer, iStartDatecol As Integer, iEndDatecol As Integer
    Dim cell As Range, myrange As Range

    Application.ScreenUpdating = False

    With ActiveSheet
        iTitlerow = .UsedRange.Find("Title", , xlValues, xlWhole).Row + 1
        iTitlecol = .UsedRange.Find("Title", , xlValues, xlWhole).Column
        iHBStartDatecol = .UsedRange.Find("HB Start Date", , xlValues, xlWhole).Column
        iHBEndDatecol = .UsedRange.Find("HB End Date", , xlValues, xlWhole).Column
        iStartDatecol = .UsedRange.Find("Start Date", , xlValues, xlWhole).Column
        iEndDatecol = .UsedRange.Find("End Date", , xlValues, xlWhole).Column
        Set myrange = .Range(.Cells(iTitlerow, iTitlecol), .Cells(iTitlerow, iTitlecol).End(xlDown))
    End With
    
    If Not myrange Is Nothing Then
    
        For Each cell In myrange
        
            With cell
            If .Offset(1, 0).Value = .Value Then
                If Not IsEmpty(Cells(.Row, iHBStartDatecol)) Then
                      Cells(.Row, iStartDatecol) = Cells(.Row, iHBStartDatecol)
                      Cells(.Row, iEndDatecol) = Cells(.Row, iHBEndDatecol)
                End If
                
                With .Offset(1)
                If Not IsEmpty(Cells(.Row, iHBStartDatecol)) Then
                      Cells(.Row, iStartDatecol) = Cells(.Row, iHBStartDatecol)
                      Cells(.Row, iEndDatecol) = Cells(.Row, iHBEndDatecol)
                
    End If: End With: End If: End With: Next cell: End If
    
    Application.ScreenUpdating = True
           
End Sub
 
Upvote 0
Updated code....

Code: 
Sub test()
    Dim iTitlerow As Long, iTitlecol As Integer, iHBStartDatecol As Integer
    Dim iHBEndDatecol As Integer, iStartDatecol As Integer, iEndDatecol As Integer
    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
        If iTitlerow * iTitlecol * iHBStartDatecol * iHBEndDatecol * iStartDatecol * iEndDatecol > 0 Then
            Set myrange = .Range(.Cells(iTitlerow + 1, iTitlecol), .Cells(iTitlerow, iTitlecol).End(xlDown))
        End If
    End With
    On Error GoTo 0
       
    For Each cell In myrange
    
        With cell
        If .Offset(1).Value = .Value Then
            If Not IsEmpty(Cells(.Row, iHBStartDatecol)) Then
                  Cells(.Row, iStartDatecol) = Cells(.Row, iHBStartDatecol)
                  Cells(.Row, iEndDatecol) = Cells(.Row, iHBEndDatecol)
            End If
            
            With .Offset(1)
            If Not IsEmpty(Cells(.Row, iHBStartDatecol)) Then
                  Cells(.Row, iStartDatecol) = Cells(.Row, iHBStartDatecol)
                  Cells(.Row, iEndDatecol) = Cells(.Row, iHBEndDatecol)
                
    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
 
Last edited:
Upvote 0
Thanks so much Alphafrog - that worked perfectly!!

One last question or add-on to this macro: if I had two extra columns called HDate and Gdate, could i have the macro clear the contents of these cells on the two rows the date move over? That is, on the first row, hdate1 and gdate1 are both cleared and on the second row, just gdate is cleared. See example below. Your help is much appreciated!

Before Macro:
<table border="0" cellpadding="0" cellspacing="0" width="505"><col style="width: 48pt;" width="64"> <col style="width: 65pt;" width="86"> <col style="width: 53pt;" width="70"> <col style="width: 70pt;" width="93"> <col style="width: 48pt;" width="64" span="3"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl24" style="height: 12.75pt; width: 48pt;" width="64" height="17">Title</td> <td class="xl24" style="width: 65pt;" width="86">HB Start Date</td> <td class="xl24" style="width: 53pt;" width="70">HB End Date</td> <td class="xl24" style="width: 70pt;" width="93">Start Date</td> <td class="xl24" style="width: 48pt;" width="64">End Date</td> <td class="xl24" style="width: 48pt;" width="64">Hdate</td> <td class="xl24" style="width: 48pt;" width="64">Gdate</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title1</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td>hdate1</td> <td>gdate</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>date1</td> <td>date2</td> <td>
</td> <td>
</td> <td>hdate1</td> <td>gdate</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>date1</td> <td>date2</td> <td>
</td> <td>
</td> <td>hdate1</td> <td>gdate</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td>hdate1</td> <td>gdate</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td>hdate1</td> <td>gdate
</td> </tr> </tbody></table>
After Macro:
<table border="0" cellpadding="0" cellspacing="0" width="505"><col style="width: 48pt;" width="64"> <col style="width: 65pt;" width="86"> <col style="width: 53pt;" width="70"> <col style="width: 70pt;" width="93"> <col style="width: 48pt;" width="64" span="3"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl24" style="height: 12.75pt; width: 48pt;" width="64" height="17">Title</td> <td class="xl24" style="width: 65pt;" width="86">HB Start Date</td> <td class="xl24" style="width: 53pt;" width="70">HB End Date</td> <td class="xl24" style="width: 70pt;" width="93">Start Date</td> <td class="xl24" style="width: 48pt;" width="64">End Date</td> <td class="xl24" style="width: 48pt;" width="64">Hdate</td> <td class="xl24" style="width: 48pt;" width="64">Gdate</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title1</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td>hdate1</td> <td>gdate</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>
</td> <td>
</td> <td>date1</td> <td>date2</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title2</td> <td>
</td> <td>
</td> <td>date1</td> <td>date2</td> <td>hdate1</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td>hdate1</td> <td>gdate</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">Title3</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td>hdate1</td> <td>gdate</td> </tr> </tbody></table>
 
Upvote 0
Are the HDate and GDate columns always the two columns to the immediate right of End Date?

Also, are all the columns consecutive with no other columns in between e.g.
Excel Workbook
CDEFGHI
3TitleHB Start DateHB End DateStart DateEnd DateGdateHdate
Sheet
 
Upvote 0
They are not always to the right End Date and are not always consecutive. They can be in any column. Is there a way to use the header in row 1 to identify these columns? Thanks.
 
Upvote 0
Code: 
Sub test()
    Dim iTitlerow As Long, iTitlecol As Integer, iHBStartDatecol As Integer
    Dim iHBEndDatecol As Integer, iStartDatecol As Integer, iEndDatecol As Integer
    [COLOR="Red"]Dim iGDate As Long, iHDate As Long[/COLOR]
    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))
[COLOR="Red"]        iHDate = .UsedRange.Find("Hdate").Column
        iGDate = .UsedRange.Find("Gdate").Column[/COLOR]
    End With
    On Error GoTo 0
       
    For Each cell In myrange
    
        With cell
        If .Offset(1).Value = .Value Then
            If Not IsEmpty(Cells(.Row, iHBStartDatecol)) Then
                  Cells(.Row, iStartDatecol) = Cells(.Row, iHBStartDatecol)
                  Cells(.Row, iEndDatecol) = Cells(.Row, iHBEndDatecol)
[COLOR="Red"]                  Cells(.Row, iHDate).ClearContents
                  Cells(.Row, iGDate).ClearContents[/COLOR]
            End If
            
            With .Offset(1)
            If Not IsEmpty(Cells(.Row, iHBStartDatecol)) Then
                  Cells(.Row, iStartDatecol) = Cells(.Row, iHBStartDatecol)
                  Cells(.Row, iEndDatecol) = Cells(.Row, iHBEndDatecol)
[COLOR="Red"]                  Cells(.Row, iGDate).ClearContents[/COLOR]
            
                
    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
 
Upvote 0
Hi AlphaFrog, sorry one last little thing (and I should have mentioned this in my original post) but is there way to have the macro only move dates if it finds just two Titles that are sequential? That is, if there is a third title or more that is sequential, the macro does not move anything. Only if there are two sequential titles:

Will moves dates:
Title1
Title2
Title2
Title3

*Title2 info will move

Will not move:
Title1
Title2
Title2
Title2
Title3

*Nothing moves because there are 3 Title2s

Again, thanks so much for your help!
 
Upvote 0
You wrote a very nice macro originally. These small changes should be easy for you to implement I would think. The principals in the new macro are essentially the same as your original code.
Code: 
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
        If .Offset(1).Value = .Value [COLOR="Red"]And _
           .Offset(2).Value <> .Value And _
           .Offset(-1).Value <> .Value[/COLOR] Then
           
            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
 
Upvote 0
Out of curiosity (and because I'm trying to learn VBA better), how would I modify this if I wanted the macro to search for 3 (and only 3) consecutive titles? something like this I would imagine...can't quite get this to work..



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 + 2, 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
If .Offset(1).Value = .Value And _
.Offset(2).Value <> .Value And _
.Offset(-1).Value <> .Value And_
.Offset(-2).Value <> .Value Then

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</pre>
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
619
smozgur
smozgur
E
  • Question Question
VBA for Web Scraping help
Replies
0
Views
921
epactheactor
E
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
2K
CrashOD
C
M
  • Question Question
Help with FilterXML formula
Replies
0
Views
2K
montex01
M
D
  • Question Question
How to output a dynamic range where the height of the range varies
Replies
0
Views
1K
dagda13
D

Forum statistics

Threads
1,224,552
Messages
6,179,484
Members
452,917
Latest member
MrsMSalt

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