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

fvisions

Board Regular
Joined
Jul 29, 2008
Messages
191
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
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
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
 
Upvote 0
Solution
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,037
Members
448,543
Latest member
MartinLarkin

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