Need specific row to be moved

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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.



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

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Maybe modify this section as shown below.

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

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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.
 
Last edited:

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Sorry, I didn't read your post. You already told me what to do. I tried to update the area as shown

VBA Code:
                                    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:
  • VBA Code:
    .RowLine.EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)

You might need some context, so here is the entire sub:
VBA Code:
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

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

My error :
Remove the period from in front of Rowline as shown below.
VBA Code:
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.

VBA Code:
.Offset(1).EntireRow.Delete
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Rich (BB code):
         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

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
This is what I have:

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

VBA Code:
RowNumber = RowLine.Row - 3
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
TThe code moves the correct row but after that, I get an error message saying Object required and it highlights this row

VBA Code:
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.
 
Solution

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Sweet!! That works perfectly, thankyou.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,098
Messages
5,622,683
Members
415,920
Latest member
ExcelNoob28

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
Top