Need specific row to be moved

[dpaton05]

I have a sub that cycles through the correct, filtered entries, asking if they are the correct entry. I have two entries that are filtered and am asked the question twice.


At the moment

• if I have 2 filtered rows, it doesn't matter what row I press Yes for, they both will be moved to the cancellations sheet.

What I need

• If I press Yes when a certain row is highlighted, that row is moved to the cancellations sheet as per the code below.

Sub Transfer()
        Dim ws As Worksheet, sh As Worksheet, sht As Worksheet, AutoFilterCounter As Long
        Set sh = Sheets("Totals")
        Set sht = Sheets("Cancellations")
        Dim Req As String: Req = sh.[B25].Value
        Dim Dt As String: Dt = sh.[B27].Value
        Dim SheetCounter As Integer: SheetCounter = 0
'Call TurnOffFunctionality
        
        For Each ws In Worksheets
                If ws.Name <> "Cancellations" And ws.Name <> "Totals" And ws.Name <> "Sheet2" Then
                        With ws.[A3].CurrentRegion
                                .AutoFilter 1, Dt           ' autofilter for the value in cell [B27]
                                .AutoFilter 3, Req          ' autofilter for the value in cell [B25]
                                                                    'Check to see if the date cell, column A, for a job has anything in it. If it doesn't, turn the autofilter off and skip to the next sheet.
                                    If ws.[A3].Cells.Offset(1, 0) = "" Then
                                        .AutoFilter
                                        SheetCounter = SheetCounter + 1
                                        'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                        If SheetCounter = 12 Then
                                            MsgBox "A job with the date and request number entered does not exist"
                                        End If
                                        GoTo SkipSheet
                                    End If
                                    
                                'Check the count Autofilter
                                AutoFilterCounter = .Columns(1).SpecialCells(xlCellTypeVisible).Count
                                'If value less than 2, only the heading is visible so skip to the next sheet.
                                If AutoFilterCounter < 2 Then
                                    .AutoFilter
                                    'Add 1 to a sheet counter
                                    SheetCounter = SheetCounter + 1
                                    'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                    If SheetCounter = 12 Then
                                        MsgBox "A job with the date and request number entered does not exist"
                                    End If
                                    GoTo SkipSheet
                                End If
                                
                                Dim LastRow As Long
                                LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                                Dim rng As Range: Set rng = ws.Range("A4:A" & LastRow)
                                
                                Dim rws&: rws = Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count
                                'if this range is greater than 1, ask the below question, else continue
                                If rws > 1 Then
                                'If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
                                    Dim answer As Integer
                                    Dim RowNumber As Long
                                    Dim RowLine As Range
                                    Application.ScreenUpdating = True
                                    For Each RowLine In rng.SpecialCells(xlCellTypeVisible)
                                        ws.Activate
                                        RowLine.EntireRow.Interior.ColorIndex = 6
                                        answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                        RowLine.EntireRow.Interior.ColorIndex = 0
                                        If answer = vbYes Then
                                            'I had to include a -3 in here to account for the 3 rows above the data that don't have data in them
                                            RowNumber = RowLine.Row - 3
                                            GoTo FoundRightJob
                                        End If
                                        'If answer = vbNo
                                        
                                    Next RowLine
                                End If
                                
FoundRightJob:
                                .Offset(1).EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)
                                .Offset(1).EntireRow.Delete
                                .AutoFilter                 ' turn off the autofilter
                        End With
                End If
SkipSheet:
        Next ws
'sh.Range("B25,B27").ClearContents
'Call TurnOnFunctionality
End Sub

Thanks

 

[JLGWhiz]

Maybe modify this section as shown below.

                                If answer = vbYes Then  
                                            'I had to include a -3 in here to account for the 3 rows above the data that don't have data in them
                                            .RowLine.EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)
                                            RowNumber = RowLine.Row - 3
                                            GoTo FoundRightJob
                                        End If
                                        'If answer = vbNo
                                     
                                    Next RowLine
                                End If
                             
FoundRightJob:
                             
                                .Offset(1).EntireRow.Delete
                                .AutoFilter                 ' turn off the autofilter
                        End With

 

[dpaton05]

Thanks for the reply. I am not very skilled with writing vba so would you be able to tell me what I need to change please? Much of this code, I have sourced from different people. I haven't written it.

 

[dpaton05]

Sorry, I didn't read your post. You already told me what to do. I tried to update the area as shown

                                    Dim answer As Integer
                                    Dim RowNumber As Long
                                    Dim RowLine As Range
                                    Application.ScreenUpdating = True
                                    For Each RowLine In rng.SpecialCells(xlCellTypeVisible)
                                        ws.Activate
                                        RowLine.EntireRow.Interior.ColorIndex = 6
                                        answer = MsgBox("Is this the job you want to cancel?", vbQuestion + vbYesNo + vbDefaultButton2, "Cancel Job")
                                        RowLine.EntireRow.Interior.ColorIndex = 0
                                        If answer = vbYes Then
                                            .RowLine.EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)
                                            'I had to include a -3 in here to account for the 3 rows above the data that don't have data in them
                                            RowNumber = RowLine.Row - 3
                                            GoTo FoundRightJob
                                        End If
                                        'If answer = vbNo
                                      
                                    Next RowLine
                                End If
                              
FoundRightJob:
                                .Offset(1).EntireRow.Delete
                                .AutoFilter                 ' turn off the autofilter
                        End With

This will

• When I run the code, the two entries are cycled through as I want but if I press No for the question that is asked for both rows that match the criteria, the rows are deleted and not put anywhere. I need the selected row to be moved, not all of them.
• When the first row is highlighted, If I press Yes on the first time I am asked the question I get the error Object doesn't support this property or method. I press debug and the following line is highlighted:

• .RowLine.EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)

You might need some context, so here is the entire sub:

Sub Transfer()
        Dim ws As Worksheet, sh As Worksheet, sht As Worksheet, AutoFilterCounter As Long
        Set sh = Sheets("Totals")
        Set sht = Sheets("Cancellations")
        Dim Req As String: Req = sh.[B25].Value
        Dim Dt As String: Dt = sh.[B27].Value
        Dim SheetCounter As Integer: SheetCounter = 0
'Call TurnOffFunctionality
       
        For Each ws In Worksheets
                If ws.Name <> "Cancellations" And ws.Name <> "Totals" And ws.Name <> "Sheet2" Then
                        With ws.[A3].CurrentRegion
                                .AutoFilter 1, Dt           ' autofilter for the value in cell [B27]
                                .AutoFilter 3, Req          ' autofilter for the value in cell [B25]
                                                                    'Check to see if the date cell, column A, for a job has anything in it. If it doesn't, turn the autofilter off and skip to the next sheet.
                                    If ws.[A3].Cells.Offset(1, 0) = "" Then
                                        .AutoFilter
                                        SheetCounter = SheetCounter + 1
                                        'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                        If SheetCounter = 12 Then
                                            MsgBox "A job with the date and request number entered does not exist"
                                        End If
                                        GoTo SkipSheet
                                    End If
                                   
                                'Check the count Autofilter
                                AutoFilterCounter = .Columns(1).SpecialCells(xlCellTypeVisible).Count
                                'If value less than 2, only the heading is visible so skip to the next sheet.
                                If AutoFilterCounter < 2 Then
                                    .AutoFilter
                                    'Add 1 to a sheet counter
                                    SheetCounter = SheetCounter + 1
                                    'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                    If SheetCounter = 12 Then
                                        MsgBox "A job with the date and request number entered does not exist"
                                    End If
                                    GoTo SkipSheet
                                End If
                               
                                Dim LastRow As Long
                                LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                                Dim rng As Range: Set rng = ws.Range("A4:A" & LastRow)
                               
                                Dim rws&: rws = Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count
                                'if this range is greater than 1, ask the below question, else continue
                                If rws > 1 Then
                                'If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
                                    Dim answer As Integer
                                    Dim RowNumber As Long
                                    Dim RowLine As Range
                                    Application.ScreenUpdating = True
                                    For Each RowLine In rng.SpecialCells(xlCellTypeVisible)
                                        ws.Activate
                                        RowLine.EntireRow.Interior.ColorIndex = 6
                                        answer = MsgBox("Is this the job you want to cancel?", vbQuestion + vbYesNo + vbDefaultButton2, "Cancel Job")
                                        RowLine.EntireRow.Interior.ColorIndex = 0
                                        If answer = vbYes Then
                                            .RowLine.EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)
                                            'I had to include a -3 in here to account for the 3 rows above the data that don't have data in them
                                            RowNumber = RowLine.Row - 3
                                            GoTo FoundRightJob
                                        End If
                                        'If answer = vbNo
                                       
                                    Next RowLine
                                End If
                               
FoundRightJob:
                                .Offset(1).EntireRow.Delete
                                .AutoFilter                 ' turn off the autofilter
                        End With
                End If
SkipSheet:
        Next ws
'sh.Range("B25,B27").ClearContents
'Call TurnOnFunctionality
End Sub

 

[JLGWhiz]

My error :
Remove the period from in front of Rowline as shown below.

RowLine.EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)

The original code was set up to delete the filtered rows after the selections was made. I did not change that so it will still delete any rows remaining in the filter range. If you do not want those rows deleted, then delete this line of code.

.Offset(1).EntireRow.Delete

 

[dpaton05]

Thanks for your ongoing help. It works a little better now.

I run the code with 2 identical entries. The code cycles through both entries and asks whether each entry is the correct one. If I select yes on an entry, that entry is moved to the cancellations sheet but both entries are still deleted on the monthly sheet. I need just that one entry to be deleted off the monthly sheet.

 

[JLGWhiz]

         If answer = vbYes Then
            RowLine.EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)
            RowLine.EntireRow.Delete  'moved from FoundRightJob Label
            'I had to include a -3 in here to account for the 3 rows above the data that don't have data in them
            RowNumber = RowLine.Row - 3
            GoTo FoundRightJob:
        End If
        'If answer = vbNo
    Next RowLine
End If
FoundRightJob:  'All delete code removed from this label
            .AutoFilter                 ' turn off the autofilter
End With

This is what that secdtion of code should look like to get only the selected row deleted. BTW, when using labels for GoTo statements they should be terminated with a colon as shown in the above code. The colon tells the compiler that it is a label. By using the GoTo statement, you jump out of your For Each loop and proceed to the End Sub. If that is what you want, then it is fine the way it is set up.

 

[dpaton05]

This is what I have:

                                Dim rws&: rws = Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count
                                'if this range is greater than 1, ask the below question, else continue
                                If rws > 1 Then
                                'If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
                                    Dim answer As Integer
                                    Dim RowNumber As Long
                                    Dim RowLine As Range
                                    Application.ScreenUpdating = True
                                    For Each RowLine In rng.SpecialCells(xlCellTypeVisible)
                                        ws.Activate
                                        RowLine.EntireRow.Interior.ColorIndex = 6
                                        answer = MsgBox("Is this the job you want to cancel?", vbQuestion + vbYesNo + vbDefaultButton2, "Cancel Job")
                                        RowLine.EntireRow.Interior.ColorIndex = 0
                                        If answer = vbYes Then
                                            'Copy and paste the selected row
                                            RowLine.EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)
                                            RowLine.EntireRow.Delete
                                            'I had to include a -3 in here to account for the 3 rows above the data that don't have data in them
                                            RowNumber = RowLine.Row - 3
                                            GoTo FoundRightJob
                                        End If
                                        'If answer = vbNo
                                        
                                    Next RowLine
                                End If
                                
FoundRightJob:

                                .AutoFilter                 ' turn off the autofilter
                        End With
                End If
SkipSheet:
        Next ws

The code moves the correct row but after that, I get an error message saying Object required and it highlights this row

RowNumber = RowLine.Row - 3

 

[JLGWhiz]

TThe code moves the correct row but after that, I get an error message saying Object required and it highlights this row

RowNumber = RowLine.Row - 3

I think you can just delete that line of code. It does nothing. Put an apostrophe in front of it to take it out of play.

 

[dpaton05]

Sweet!! That works perfectly, thankyou.