For each stops early, sometimes

M

mharper90

Board Regular
Joined
May 28, 2013
Messages
117
Office Version
  1. 365
Platform
  1. MacOS
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?


Code: 
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
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Sort by date Sort by votes
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)
Click to expand...
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.
 
Last edited:
Upvote 0
I tried this (saving in the middle), and it didn't fix it. Any other thoughts?
 
Upvote 0
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!!!

Code: 
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
 
Upvote 0
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
 
Upvote 0
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.

Code: 
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).

Code: 
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."

Code: 
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
 
Upvote 0
Try changing this in the 3rd macro

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

To

Code: 
With ws2.Range("C3:D" & LrB2)
                .value=.value
End With
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
372
NdNoviceHlp
NdNoviceHlp
Logit
  • Question Question
Search In Other Workbook - Copy/Paste Offset Data To First Workbook - Repeat Process
Replies
7
Views
357
Logit
Logit
K
  • Solved
Code to search job id from multiple sources and update main spreadsheet.
2
Replies
10
Views
681
mumps
mumps
B
  • Question Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
2
Views
572
B-radK
B
S
  • Solved
Tweak Macro that Imports specific table columns from a different workbook to filter a column first
Replies
4
Views
507
sspatriots
S

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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