For each stops early, sometimes

[mharper90]

I'm trying to use the following code to find some dates (VLOOKUP) on a different worksheet and fix their values in place (Copy/PasteSpecial). Then the macro should look through the dates and clear them if they are in the future (> Date).

This macro works, but the first time it's run after a new row of data is added to ws2 (happens in a macro before this one), the last row seems to be overlooked by the "For each" section of this macro. But then, if I manually run just this macro again, it will correct itself.

I've added a msg box to display the value of LrB2, and it always displays the accurate number of rows (including after a new row addition). Any thoughts?


Also, a bonus question... When this macro finishes running, it leaves the pasted area selected. What's the code to deselect, so that there isn't a dotted box around the newly pasted area?

Sub updateDates()

Dim ws2 As Worksheet:     Set ws2 = ThisWorkbook.Sheets("Main Data")
Dim LrB2 As Long
Dim c As Range

LrB2 = ws2.Range("A" & Rows.Count).End(xlUp).Row

MsgBox (LrB2)

On Error Resume Next

If LrB2 > 2 Then
     ws2.Range("C3:C" & LrB2).Formula = "=VLOOKUP(A3, 'Main Data'!B:S,4,FALSE)"
     ws2.Range("D3:D" & LrB2).Formula = "=VLOOKUP(A3, 'Main Data'!B:S,5,FALSE)"
     ws2.Columns ("C:D").Copy
     ws2.Range("C3").PasteSpecial xlPasteValues
Else
End If

For Each c In ws2.Range("C3:D" & LrB2)
     If c > Date Then
          c = ""
     Else
     End If
Next

End Sub

 

[Joe4]

This macro works, but the first time it's run after a new row of data is added to ws2 (happens in a macro before this one)

Try having the macro that is adding new rows re-save the file after adding the rows (and before this other macro is run), and see if that makes a difference.

 

[mharper90]

I tried this (saving in the middle), and it didn't fix it. Any other thoughts?

 

[Trebor76]

Hi mharper90,

Be careful when using On Error Resume Next as all it does is stops error messages appearing but in no way tries the fix the error. When I commented out this line and ran your code there was an error with the way the macro was trying to convert the copied range to values. As such I have written the following which hopefully resolves your issue - including the bonus question!!!

Option Explicit
Sub updateDates()

    Dim ws2 As Worksheet:     Set ws2 = ThisWorkbook.Sheets("Main Data")
    Dim LrB2 As Long
    Dim c As Range
    
    Application.ScreenUpdating = False
    
    LrB2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    
    MsgBox (LrB2)
    
    On Error Resume Next
    
        If LrB2 > 2 Then
             ws2.Range("C3:C" & LrB2).Formula = "=VLOOKUP(A3, 'Main Data'!B:S,4,FALSE)"
             ws2.Range("D3:D" & LrB2).Formula = "=VLOOKUP(A3, 'Main Data'!B:S,5,FALSE)"
             With ws2.Range("C3:D" & LrB2)
                .Copy
                .PasteSpecial xlPasteValues
                Application.CutCopyMode = False '•Removes the 'marching ants' from the above copy range
            End With
        End If
    
        For Each c In ws2.Range("C3:D" & LrB2)
            If c > Date Then
                c = ""
            End If
        Next c
        
    On Error GoTo 0
    
    Application.ScreenUpdating = False

End Sub

Regards,

Robert

 

[Michael M]

Have you tried
1. recreating LrB2 just before the for each loop
2. don't copy entire columns....utilise LrB2......ws2.range ("C1:D" & lrB2).Copy
3. restrict your range in the VLOOKUP to a range NOT entire columns...eg, Main Data'!B1:S1000,4,FALSE
4. To get rid of the dotted lines..... Application.CutCopyMode = False

 

[mharper90]

Any help is greatly appreciated! This one spot of the code is just driving me nuts! lol

I've tried a few different variations on the code recommended to me, and here's the problems I'm still having:


A) This version works as it should for VLOOKUP, leaving the VLOOKUP in the cell since the copy and paste special is commented out. Except, the For Each portion of the code still leaves the last row (which is a new addition) untouched (meaning it does not apply the If statement to the last row). LrB2 appears in a MsgBox as the appropriate value for the last row of the new data.

Option Explicit
Sub updateDates()

    Dim ws2 As Worksheet:     Set ws2 = ThisWorkbook.Sheets("Main Data")
    Dim LrB2 As Long
    Dim c As Range
    
    Application.ScreenUpdating = False
    
    LrB2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    
    MsgBox (LrB2)
    
    '  On Error Resume Next
    
        If LrB2 > 2 Then
             ws2.Range("C3:C" & LrB2).Formula = "=VLOOKUP(A3, 'Main Data'!B:S,4,FALSE)"
             ws2.Range("D3:D" & LrB2).Formula = "=VLOOKUP(A3, 'Main Data'!B:S,5,FALSE)"
    '         With ws2.Range("C3:D" & LrB2)
    '            .Copy
    '            .PasteSpecial xlPasteValues
    '            Application.CutCopyMode = False
    '        End With
        End If
    
        For Each c In ws2.Range("C3:D" & LrB2)
            If c > Date Then
                c = ""
            End If
        Next c
        
    On Error GoTo 0
    
    Application.ScreenUpdating = False

End Sub

B) This version works to apply paste special date value to the cells, EXCEPT that during the paste special operation, it turns the last row (which is a new addition), into "0 Jan 00" for both columns C and D; therefore, I'm not sure if the For Each function is working in the last row, because these 0 Jan 00 dates do not meet the criteria to be cleared. If the macro is run another time without a new row addition, it fixes itself and works completely as it should. LrB2 still appears in a MsgBox as the appropriate value for the last row of the new data (every time).

Option Explicit
Sub updateDates()

    Dim ws2 As Worksheet:     Set ws2 = ThisWorkbook.Sheets("Main Data")
    Dim LrB2 As Long
    Dim c As Range
    
    Application.ScreenUpdating = False
    
    LrB2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    
    MsgBox (LrB2)
    
    '  On Error Resume Next
    
        If LrB2 > 2 Then
             ws2.Range("C3:C" & LrB2).Formula = "=VLOOKUP(A3, 'Main Data'!B:S,4,FALSE)"
             ws2.Range("D3:D" & LrB2).Formula = "=VLOOKUP(A3, 'Main Data'!B:S,5,FALSE)"
             With ws2.Range("C3:D" & LrB2)
                .Copy
                .PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
        End If
    
        For Each c In ws2.Range("C3:D" & LrB2)
            If c > Date Then
                c = ""
            End If
        Next c
        
    On Error GoTo 0
    
    Application.ScreenUpdating = False

End Sub

C) I tried this just as an experiment, and I get a "Runtime Error 1004. Unable to get the PasteSpecial property of the Range class."

Option Explicit
Sub updateDates()

    Dim ws2 As Worksheet:     Set ws2 = ThisWorkbook.Sheets("Main Data")
    Dim LrB2 As Long
    Dim c As Range
    
    Application.ScreenUpdating = False
    
    LrB2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    
    MsgBox (LrB2)
    
    '  On Error Resume Next
    
        If LrB2 > 2 Then
             ws2.Range("C3:C" & LrB2).Formula = "=VLOOKUP(A3, 'Main Data'!B:S,4,FALSE)"
             ws2.Range("D3:D" & LrB2).Formula = "=VLOOKUP(A3, 'Main Data'!B:S,5,FALSE)"
             With ws2.Range("C3:D" & LrB2)
                .Copy (ws2.Range("C3").PasteSpecial(xlPasteValues))

            End With
        End If
    
        For Each c In ws2.Range("C3:D" & LrB2)
            If c > Date Then
                c = ""
            End If
        Next c
        
    On Error GoTo 0
    
    Application.ScreenUpdating = False

End Sub

 

[Michael M]

Try changing this in the 3rd macro

With ws2.Range("C3:D" & LrB2)
                .Copy (ws2.Range("C3").PasteSpecial(xlPasteValues))
End With

To

With ws2.Range("C3:D" & LrB2)
                .value=.value
End With