Find list of number from one worksheet and paste to another worksheet

fvisions

Board Regular
Joined
Jul 29, 2008
Messages
184
Office Version
  1. 365
Platform
  1. Windows
I have a code that looks at sheet 1 and finds any row with the word END and cuts the full row and pastes it to sheet 2. How do I create a code instead to look at sheet 3 column c (loan number) and finds it in sheet 1 then cuts and pastes the full row to sheet 2. The loan numbers will be different each month. There is only about 20 accounts to lookup.

Can I copy this code and revise it for my needs or do you advise a better way?

VBA Code:
Sub MoveRowBasedOnCellValue()
'delete End Items and copy to Notes tab

Dim xRg As Range
Dim xCell As Range
Dim i As Long
Dim J As Long
Dim K As Long
i = Worksheets("Installation wkg").UsedRange.Rows.Count
J = Worksheets("END_NO CHANGE LIST").UsedRange.Rows.Count
J = 1
Set xRg = Worksheets("Installation wkg").Range("w1:w" & i)
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "END" Then
xRg(K).EntireRow.Cut Destination:=Worksheets("END_NO CHANGE LIST").Range("a" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,384
VBA Code:
Sub Move_Accounts()
    
    Dim cell As Range
    Dim Found As Range
    Dim counter As Long
    
    Application.ScreenUpdating = False
    
    For Each cell In Sheets(3).Range("C2", Sheets(3).Range("C" & Rows.Count).End(xlUp))
    
        If Not IsEmpty(cell) Then
        
            Set Found = Sheets(1).Cells.Find(What:=cell.Value, _
                                             LookIn:=xlValues, _
                                             LookAt:=xlWhole, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlNext, _
                                             MatchCase:=False)
                
            If Not Found Is Nothing Then
                Do
                    Found.EntireRow.Cut Destination:=Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1)
                    Set Found = Sheets(1).Cells.FindNext(After:=Found)
                    counter = counter + 1
                Loop Until Found Is Nothing
            End If
        End If
    Next cell
    
    Application.ScreenUpdating = True
    MsgBox counter & " accounts moved.", vbInformation, "Accounts Moved Complete"
    
End Sub
 
Solution

fvisions

Board Regular
Joined
Jul 29, 2008
Messages
184
Office Version
  1. 365
Platform
  1. Windows
VBA Code:
Sub Move_Accounts()
   
    Dim cell As Range
    Dim Found As Range
    Dim counter As Long
   
    Application.ScreenUpdating = False
   
    For Each cell In Sheets(3).Range("C2", Sheets(3).Range("C" & Rows.Count).End(xlUp))
   
        If Not IsEmpty(cell) Then
       
            Set Found = Sheets(1).Cells.Find(What:=cell.Value, _
                                             LookIn:=xlValues, _
                                             LookAt:=xlWhole, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlNext, _
                                             MatchCase:=False)
               
            If Not Found Is Nothing Then
                Do
                    Found.EntireRow.Cut Destination:=Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1)
                    Set Found = Sheets(1).Cells.FindNext(After:=Found)
                    counter = counter + 1
                Loop Until Found Is Nothing
            End If
        End If
    Next cell
   
    Application.ScreenUpdating = True
    MsgBox counter & " accounts moved.", vbInformation, "Accounts Moved Complete"
   
End Sub
Run error 9 subscript out of range on:
VBA Code:
 Found.EntireRow.Cut Destination:=Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1)

Below is the code with the sheet names;

VBA Code:
Sub Move_Accounts()
    
    Dim cell As Range
    Dim Found As Range
    Dim counter As Long
    
    Application.ScreenUpdating = False
    For Each cell In Sheets("C4C Off Bill List").Range("C2", Sheets("C4C Off Bill List").Range("C" & Rows.Count).End(xlUp))
        If Not IsEmpty(cell) Then
            Set Found = Sheets("C4C on bill reconciliation").Cells.Find(What:=cell.Value, _
                                             LookIn:=xlValues, _
                                             LookAt:=xlWhole, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlNext, _
                                             MatchCase:=False)
                
            If Not Found Is Nothing Then
                Do
                    Found.EntireRow.Cut Destination:=Sheets("C4C off bill reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    Set Found = Sheets("C4C on bill reconciliation").Cells.FindNext(After:=Found)
                    counter = counter + 1
                Loop Until Found Is Nothing
            End If
        End If
    Next cell
    
    Application.ScreenUpdating = True
    MsgBox counter & " accounts moved.", vbInformation, "Accounts Moved Complete"
    
End Sub
 

fvisions

Board Regular
Joined
Jul 29, 2008
Messages
184
Office Version
  1. 365
Platform
  1. Windows
Run error 9 subscript out of range on:
VBA Code:
 Found.EntireRow.Cut Destination:=Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1)

Below is the code with the sheet names;

VBA Code:
Sub Move_Accounts()
   
    Dim cell As Range
    Dim Found As Range
    Dim counter As Long
   
    Application.ScreenUpdating = False
    For Each cell In Sheets("C4C Off Bill List").Range("C2", Sheets("C4C Off Bill List").Range("C" & Rows.Count).End(xlUp))
        If Not IsEmpty(cell) Then
            Set Found = Sheets("C4C on bill reconciliation").Cells.Find(What:=cell.Value, _
                                             LookIn:=xlValues, _
                                             LookAt:=xlWhole, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlNext, _
                                             MatchCase:=False)
               
            If Not Found Is Nothing Then
                Do
                    Found.EntireRow.Cut Destination:=Sheets("C4C off bill reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    Set Found = Sheets("C4C on bill reconciliation").Cells.FindNext(After:=Found)
                    counter = counter + 1
                Loop Until Found Is Nothing
            End If
        End If
    Next cell
   
    Application.ScreenUpdating = True
    MsgBox counter & " accounts moved.", vbInformation, "Accounts Moved Complete"
   
End Sub
IT WORKS!!! The error was my sheet name for one of the worksheets. Thank you for your help.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,253
Messages
5,600,544
Members
414,387
Latest member
Vincent88

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