Message Pop Up

[CarlStephens]

Hello Everyone,

I have the below code that basically searches for required information on one sheet and then pastes it onto another sheet when it finds it, however, there arent always new information to paste across and I am wondering whether there is a code to add to the below that when there is no new information to copy and paste across that a message box will appear to say "No new employee records found" - is this possible? Thank you.

Sub CoypFilteredData()

Dim wsData      As Worksheet
Dim wsDest      As Worksheet
Dim lr          As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("1. MAPS List")
Set wsDest = Worksheets("2. Joiners List")

wsData.Unprotect ("ML")


lr = wsData.Cells(Rows.Count, "AP").End(xlUp).Row

If wsData.FilterMode Then wsData.ShowAllData

With wsData.Rows(1)
    .AutoFilter Field:=42, Criteria1:="Not On Joiners List"
    .AutoFilter Field:=43, Criteria1:="<90"
    If wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        wsData.Range("AR2:AU" & lr).SpecialCells(xlCellTypeVisible).copy
        wsDest.Range("AC" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
        wsDest.Select
    End If
    .AutoFilter Field:=42
    .AutoFilter Field:=43
    Range("AP1").Select
wsData.EnableAutoFilter = True
wsData.Protect Password:="ML", UserInterfaceOnly:=True
End With
Application.ScreenUpdating = True
End Sub

 

[Fluff]

How about

    If wsData.Range("H1:H" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        wsData.Range("AR2:AU" & LR).SpecialCells(xlCellTypeVisible).Copy
        wsDest.Range("AC" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
        wsDest.Select
    Else
        MsgBox "No new employee records found"
    End If

 

[CarlStephens]

If wsData.Range("H1:H" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then wsData.Range("AR2:AU" & LR).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("AC" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues wsDest.Select Else MsgBox "No new employee records found"

Thank worked a treat thank you very much.

Would there be a code that in the instance there are records copied across to the other sheet, that message popped up to say there were x amount of records copied across based on the amount of rows that were copied?

 

[Fluff]

How about

    If wsData.Range("H1:H" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        wsData.Range("AR2:AU" & LR).SpecialCells(xlCellTypeVisible).Copy
        wsDest.Range("AC" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
        wsDest.Select
        MsgBox wsData.Range("H1:H" & LR).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " records copied"
    Else
        MsgBox "No new employee records found"
    End If

 

[CarlStephens]

If wsData.Range("H1:H" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then wsData.Range("AR2:AU" & LR).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("AC" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues wsDest.Select MsgBox wsData.Range("H1:H" & LR).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " records copied"

You are a legend, thank you again....I really appreciate your assistance.

 

[Fluff]

You're welcome & thanks for the feedback.

 

[CarlStephens]

Hello,

The code above only works to 50,000 rows....anything after this, there are errors. Do you know what is causing this? Thank you.

 

[Fluff]

What sort of errors?

 

[CarlStephens]

The sheet/range that I have the code working from has around 55,000 rows of data (formulas), and when there are anything more than 50,000 rows, the code copies across 5001 rows, but 5000 rows are blank and one is an employee record. When I delete the 5000 rows worth of formulas to have only 50,000 rows of data, then the code works fine.

 

[CarlStephens]

...it also does not find then next blank row on the destination sheet and pastes some 5000 rows below.