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!
 
Sort by date Sort by votes
It would be best if you surround your VBA code with code tags e.g.; [CODE]your VBA code here[/CODE]
It makes reading your VBA code much easier.
When you're in the forum editor, highlight your pasted VBA code and then click on the pound # icon.


Code: 
        With cell
        If .Offset(-1).Value <> .Value And _
           .Offset(1).Value = .Value And _
           .Offset(2).Value = .Value And _
           .Offset(3).Value <> .Value Then

Cell above not equal to Cell. Prevents matching 4 or more consecutive titles.
Cell one row below is equal to Cell
Cell two rows below is equal to Cell
Cell three rows below not equal to Cell. Prevents matching 4 or more consecutive titles.
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Thanks - Here is the updated code. If I wanted to arrange or edit the second offset (the third row) with the macro - would it look like this?


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[COLOR=Red] + 2[/COLOR], 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
    
        <!--[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]-->  [FONT=Arial]        With cell[/FONT]
  [FONT=Arial]        If .Offset(-1).Value <> .Value And _[/FONT]
  [FONT=Arial]           .Offset(1).Value = .Value And _[/FONT]
  [FONT=Arial]           .Offset(2).Value = .Value And _[/FONT]
  [FONT=Arial]           .Offset(3).Value <> .Value Then[/FONT]
  
           
            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

[COLOR=Red]With .Offset(2)
             If Not IsEmpty(Cells(.Row, iHBStartDatecol)) Then
                   Cells(.Row, iStartDatecol) = Cells(.Row, iHBStartDatecol)
                   Cells(.Row, iEndDatecol) = Cells(.Row, iHBEndDatecol)
                   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
Looks good to me. You could always test it an see what happens.

On another note...
This should remain as +1 I think.
Code: 
Set myrange = .Range(.Cells(iTitlerow [COLOR="Red"]+ 1[/COLOR], iTitlecol), .Cells(iTitlerow, iTitlecol).End(xlDown))

iTitlerow is the row number where the header "Title" is found. You want to set myrange to always start one row below the header (iTitlerow + 1) no matter how many consecutive titles you are looking for.

EDIT:
You may want to add an End With above With .Offset(2)
Code: 
End With   [COLOR="Green"]'Ends the [I]With .Offset(1)[/I][/COLOR]
With .Offset(2)
             If Not IsEmpty(Cells(.Row, iHBStartDatecol)) Then
 
Last edited:
Upvote 0
Thanks Alpha Frog - seems like the code is having trouble with that third row - I get several error messages when trying to run it such as "End With Without With" and "Next Without For." I have tried adding in these lines with no luck - just more error messages. Or, when I do add in enough of these lines to run debug without error messages, it does not do anything to the last line of code, only the first two..any advice?

Thank you!
 
Upvote 0
here's the code I wrote...still can't quite get that last offset (the third row) to move. Not sure why because I'm using the "With .Offset (2)" just like I use in offset 1..

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
    
    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 And _
             .Offset(1).Value = .Value And _
             .Offset(2).Value = .Value And _
             .Offset(3).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
                  Cells(.Row, iHDate).ClearContents

With .Offset(2)
             If Not IsEmpty(Cells(.Row, iHBStartDatecol)) Then
                   Cells(.Row, iStartDatecol) = Cells(.Row, iHBStartDatecol)
                   Cells(.Row, iEndDatecol) = Cells(.Row, iHBEndDatecol)
                   Cells(.Row, iGDate).ClearContents
                   Cells(.Row, iHDate).ClearContents
            
                
    End If: End With: End If: End With: End If: End With: Next cell
    
    Application.ScreenUpdating = True

    
End Sub
 
Upvote 0
Looks like the code actually moves the row that should be Offset 3, that is 3 rows below the range...not sure why
 
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
706
smozgur
smozgur
E
  • Question Question
VBA for Web Scraping help
Replies
0
Views
956
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,225,156
Messages
6,183,233
Members
453,152
Latest member
ChrisMd

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