VBA - Filter Error

C

CarlStephens

Board Regular
Joined
Sep 25, 2020
Messages
128
Office Version
  1. 2016
Platform
  1. Windows
Hello Wonderful People,

I have the below code, which filters a column by the cells that have a "No" in them, and then copies the cells in "BD2:BJ" and then pastes the data to another sheet, which is working all well, with the exception that the last row in "BD2:BJ" of the filtered list is not copied across, even though the filter shows "No". Any ideas on this will be appreciated as I cannot see what the issue is. Thank you.

Sub FindNewHires()
'
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lr As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("EPS")
Set wsDest = Worksheets("OT")

wsData.Unprotect ("EPS")
wsDest.Unprotect ("OT")

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

If wsData.FilterMode Then wsData.ShowAllData

With wsData.Rows(1)
.AutoFilter Field:=53, Criteria1:="No"
If wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
wsData.Range("BD2:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
wsDest.Range("D" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
Hi CarlStevens,

any reason to get the last filled cell from Column AP instead of BA?

VBA Code: 
Sub FindNewHires()
'
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lr As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("EPS")
Set wsDest = Worksheets("OT")

wsData.Unprotect ("EPS")
wsDest.Unprotect ("OT")

With wsData
  If .FilterMode Then .ShowAllData
  lr = .Cells(Rows.Count, "BA").End(xlUp).Row
  .Rows(1).AutoFilter Field:=53, Criteria1:="No"
  If .Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
    .Range("BD2:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
    wsDest.Range("D" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
'...
Ciao,
Holger
 
Upvote 0
HaHoBe said:
Hi CarlStevens,

any reason to get the last filled cell from Column AP instead of BA?

VBA Code: 
Sub FindNewHires()
'
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lr As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("EPS")
Set wsDest = Worksheets("OT")

wsData.Unprotect ("EPS")
wsDest.Unprotect ("OT")

With wsData
  If .FilterMode Then .ShowAllData
  lr = .Cells(Rows.Count, "BA").End(xlUp).Row
  .Rows(1).AutoFilter Field:=53, Criteria1:="No"
  If .Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
    .Range("BD2:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
    wsDest.Range("D" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
'...
Ciao,
Holger
Click to expand...
Thank you, sir, that worked great. What would I need to add to the code, if a cell (F4) on the wsDest sheet was equal to 0, then the macro would not run and a message box would appear to say "No records to import."?

Thank you again.
 
Upvote 0
Hi CarlStephens,

I would use an If clause and move the unprotect as well as the protect into the Else part like

VBA Code: 
Sub FindNewHires()
'
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lr As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("EPS")
Set wsDest = Worksheets("OT")

If wsDest.Range("D4").Value = 0 Then
  MsgBox "No records to import.", vbInformation, "Nothing to do"
Else
  wsData.Unprotect ("EPS")
  wsDest.Unprotect ("OT")
  With wsData
    If .FilterMode Then wsData.ShowAllData
    lr = .Cells(Rows.Count, "BA").End(xlUp).Row
    .Rows(1).AutoFilter Field:=53, Criteria1:="No"
    If .Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      .Range("BD2:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
      wsDest.Range("D" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
    End If
  End With
  wsDest.Protect ("OT")
  wsData.Protect ("EPS")
End If

Set wsDest = Nothing
Set wsData = Nothing

End Sub

Ciao,
Holger
 
Upvote 0
HaHoBe said:
Hi CarlStephens,

I would use an If clause and move the unprotect as well as the protect into the Else part like

VBA Code: 
Sub FindNewHires()
'
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lr As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("EPS")
Set wsDest = Worksheets("OT")

If wsDest.Range("D4").Value = 0 Then
  MsgBox "No records to import.", vbInformation, "Nothing to do"
Else
  wsData.Unprotect ("EPS")
  wsDest.Unprotect ("OT")
  With wsData
    If .FilterMode Then wsData.ShowAllData
    lr = .Cells(Rows.Count, "BA").End(xlUp).Row
    .Rows(1).AutoFilter Field:=53, Criteria1:="No"
    If .Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      .Range("BD2:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
      wsDest.Range("D" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
    End If
  End With
  wsDest.Protect ("OT")
  wsData.Protect ("EPS")
End If

Set wsDest = Nothing
Set wsData = Nothing

End Sub

Ciao,
Holger
Click to expand...
Sorry, I should post the whole code for you to see.

Sub FindNewHires()
'
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lr As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("EPS")
Set wsDest = Worksheets("OT")

wsData.Unprotect ("EPS")
wsDest.Unprotect ("OT")

With wsData
If .FilterMode Then .ShowAllData
lr = .Cells(Rows.Count, "BA").End(xlUp).Row
.Rows(1).AutoFilter Field:=53, Criteria1:="No"
If .Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
.Range("BD2:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
wsDest.Range("D" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
wsDest.Select
MsgBox wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " new employee records were found and copied to copied to this tab." & vbCrLf & _
"Next, update any crew that are showing as Scheduled in column C and send joining instructions if required.", vbInformation
Else
MsgBox "No new employee records found. Please check to see who has been 'Scheduled' per column C and add the new posting details, and who need joining instructions if required.", vbInformation
End If
If .FilterMode Then .ShowAllData
wsDest.EnableAutoFilter = True
wsData.EnableAutoFilter = True
wsData.Protect Password:="EPS", UserInterfaceOnly:=True
wsDest.Protect Password:="OT", UserInterfaceOnly:=True
wsDest.Select
Application.GoTo (ActiveWorkbook.Sheets("OT").Range("C11"))

End With

End Sub
 
Upvote 0
Hi CarlStephens,

please use code tags when displaying your prcedures according to How to Post Your VBA Code

Do you search for something like

VBA Code: 
Sub FindNewHires()
'
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lr As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("EPS")
Set wsDest = Worksheets("OT")

'/// check value cell D4 first
If wsDest.Range("D4").Value = 0 Then
  MsgBox "No records to import.", vbInformation, "Nothing to do"
Else
  With wsData
    .Unprotect ("EPS")
    wsDest.Unprotect ("OT")
    If .FilterMode Then .ShowAllData
    lr = .Cells(Rows.Count, "BA").End(xlUp).Row
    .Rows(1).AutoFilter Field:=53, Criteria1:="No"
    If .Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      .Range("BD2:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
      wsDest.Range("D" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
      MsgBox wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & _
          " new employee records were found and copied to copied to this tab." & vbCrLf & _
          "Next, update any crew that are showing as Scheduled in column C and send joining instructions if required.", vbInformation
    Else
      MsgBox "No new employee records found. Please check to see who has been 'Scheduled' per column C " & _
          "and add the new posting details, and who need joining instructions if required.", vbInformation
    End If
    If .FilterMode Then .ShowAllData
    wsDest.EnableAutoFilter = True
    .EnableAutoFilter = True
    .Protect Password:="EPS", UserInterfaceOnly:=True
    wsDest.Protect Password:="OT", UserInterfaceOnly:=True
    Application.GoTo (wsDest.Range("C11"))
  End With
End If

Set wsDest = Nothing
Set wsData = Nothing
End Sub

Holger
 
Upvote 0
Solution
HaHoBe said:
Hi CarlStephens,

please use code tags when displaying your prcedures according to How to Post Your VBA Code

Do you search for something like

VBA Code: 
Sub FindNewHires()
'
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lr As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("EPS")
Set wsDest = Worksheets("OT")

'/// check value cell D4 first
If wsDest.Range("D4").Value = 0 Then
  MsgBox "No records to import.", vbInformation, "Nothing to do"
Else
  With wsData
    .Unprotect ("EPS")
    wsDest.Unprotect ("OT")
    If .FilterMode Then .ShowAllData
    lr = .Cells(Rows.Count, "BA").End(xlUp).Row
    .Rows(1).AutoFilter Field:=53, Criteria1:="No"
    If .Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      .Range("BD2:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
      wsDest.Range("D" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
      MsgBox wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & _
          " new employee records were found and copied to copied to this tab." & vbCrLf & _
          "Next, update any crew that are showing as Scheduled in column C and send joining instructions if required.", vbInformation
    Else
      MsgBox "No new employee records found. Please check to see who has been 'Scheduled' per column C " & _
          "and add the new posting details, and who need joining instructions if required.", vbInformation
    End If
    If .FilterMode Then .ShowAllData
    wsDest.EnableAutoFilter = True
    .EnableAutoFilter = True
    .Protect Password:="EPS", UserInterfaceOnly:=True
    wsDest.Protect Password:="OT", UserInterfaceOnly:=True
    Application.GoTo (wsDest.Range("C11"))
  End With
End If

Set wsDest = Nothing
Set wsData = Nothing
End Sub

Holger
Click to expand...
Thank you so much, this worked perfectly.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Copying and pasting between sheets....
Replies
1
Views
546
mmhill
M
C
  • Question Question
Copy & Paste VBA Challenge
Replies
1
Views
625
dnorm
D
C
  • Question Question
Code Error
Replies
4
Views
465
Carl Stephens
C
O
  • Question Question
User-defined type not defined - vba/excel error
Replies
4
Views
214
RoryA
RoryA
S
  • Solved
Import data to another sheet without formatting
Replies
1
Views
307
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,223,898
Messages
6,175,274
Members
452,628
Latest member
dd2

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