Copying and pasting between sheets....

[Carl Stephens]

Hello All,

I have the below code that filters on one tab and copies the desired cells which are then pasted onto another sheet, which works well.....and I am wanting to add, per the code below, a similar command that filters the wsDest tab but I am getting an error on the red ELSE below, stating Else Without If....anyone know the fix for this? Thanking you in advance.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("H4")) Is Nothing Then

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("BD3: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 - 2 & " 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
.AutoFilter Field:=53
wsDest.EnableAutoFilter = True
wsData.EnableAutoFilter = True
wsData.Protect Password:="EPS", UserInterfaceOnly:=True
wsDest.Protect Password:="OT", UserInterfaceOnly:=True
Application.Goto (ActiveWorkbook.Sheets("OT").Range("A1"))

lr = wsData.Cells(Rows.Count, "AP").End(xlUp).Row
If wsData.FilterMode Then wsData.ShowAllData

With wsData.Rows(1)
.AutoFilter Field:=52, Criteria1:="Yes"
If wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
wsData.Range("BK3:BL" & lr).SpecialCells(xlCellTypeVisible).Copy
With wsDest.Rows(10)
.AutoFilter Field:=2, Criteria1:="Scheduled"
wsDest.Range("O" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
wsDest.Select
MsgBox wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count - 2 & " 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
.AutoFilter Field:=52
wsDest.EnableAutoFilter = True
wsData.EnableAutoFilter = True
wsData.Protect Password:="EPS", UserInterfaceOnly:=True
wsDest.Protect Password:="OT", UserInterfaceOnly:=True
Application.Goto (ActiveWorkbook.Sheets("OT").Range("A1"))

End With

End If
End If
End Sub

 

[mmhill]

You get errors like that when you don't close a 'WITH' or loop. In the simple example below, WITH Y isn't closed and will error. I noted the two places in your code that were likely causing the problem. Youro code is at the bottom.

'Simple Example of the Error
With X
     If x=1 then
           With Y
                do stuff
     else
           do other stuff
     end if
End With

Three things that might be helpful in the future ...

1. Instead of

If Selection.Count = 1 Then
     'DO A TON OF STUFF IN HERE
 End If 
 Exit Sub

Flip the logic, do this in 1 line, and avoid that huge IF/END IF statement. Easier and less compicated

If Selection.Count <> 1 Then Exit Sub

2. Indent every time you use a WITH or Loop. Use line spaces to break up content.

With X

     If x=1 then
           With Y
                do stuff
           End with 
     else
           do other stuff
     end if

End With

is easier to read and debug than

With X
If x=1 then
With Y
do stuff
else
do other stuff
end if
End With

3. You can't nest WITH statements that don't nest themselves. In teh example below, the code doesn't know if .cells(2) goes wiht Row 99 or Row 20

'this does not work
With Row(20)
       .Cell(1).Value = 1
       With Row(99)
            .cell(2).value = 1
       End with
End with
'This works
With Workbooks(1)
     with .worksheets (1)
            with .cells(1,1)
                 .interior.color = xlred
             end with
     end with
End with

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Selection.Count <> 1 Then Exit Sub
    If Intersect(Target, Range("H4")) Is Nothing Then Exit Sub
    
    Dim wsData As Worksheet, wsDest As Worksheet, lr As Long
    
    Application.ScreenUpdating = False
    
    Set wsData = Worksheets("EPS"): wsData.Unprotect ("EPS")
    Set wsDest = Worksheets("OT"): wsDest.Unprotect ("OT")
    
    lr = wsData.Cells(Rows.Count, "AP").End(xlUp).Row
    
    If wsData.FilterMode Then wsData.ShowAllData
    
    With wsData.Rows(1) '** A
    
        .AutoFilter Field:=53, Criteria1:="No"
        
        If wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then '**B
            wsData.Range("BD3: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 - 2 & " 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 '**B
        
        .AutoFilter Field:=53
        wsDest.EnableAutoFilter = True
        wsData.EnableAutoFilter = True
        wsData.Protect Password:="EPS", UserInterfaceOnly:=True
        wsDest.Protect Password:="OT", UserInterfaceOnly:=True
        
        Application.Goto (ActiveWorkbook.Sheets("OT").Range("A1"))
        
        lr = wsData.Cells(Rows.Count, "AP").End(xlUp).Row
        
        If wsData.FilterMode Then wsData.ShowAllData
        
        With wsData.Rows(1) '** C << YOU DIDN'T HAVE AN END WITH FOR THIS
        
            .AutoFilter Field:=52, Criteria1:="Yes"
            
            If wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then '** D
            
                wsData.Range("BK3:BL" & lr).SpecialCells(xlCellTypeVisible).Copy
                
                'THIS 'WITH' STATEMENT IS A PROBLEM BECAUSE IT IS INSIDE THE 'WITH' STATEMENT I MARKED WITH "** C"
                'THE .AUTOFILTER STATEMENT BELOW - DOES IT BELOW TO wsDest.Rows(10) OR DOES IT BELONG TO wsData.Rows(1)? tH ECODE DOESN'T KNOW
                With wsDest.Rows(10) '** E << YOU DIDN'T HAVE AN END WITH FOR THIS
                
                    .AutoFilter Field:=2, Criteria1:="Scheduled"
                    wsDest.Range("O" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
                    wsDest.Select
                    MsgBox wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count - 2 & " 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
                    
                End With ' ** E <<< YOU WERE MISSING THIS END WITH
            
            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 '**D
            
            .AutoFilter Field:=52
            wsDest.EnableAutoFilter = True
            wsData.EnableAutoFilter = True
            wsData.Protect Password:="EPS", UserInterfaceOnly:=True
            wsDest.Protect Password:="OT", UserInterfaceOnly:=True
            Application.Goto (ActiveWorkbook.Sheets("OT").Range("A1"))
            
        End With '** C <<< YOU WERE MISSING THIS END WITH
    
    End With '** A

End Sub