Copy Data to new Worksheet Based on Column Value

slpswhite

New Member
Joined
Jan 2, 2018
Messages
39
I have a worksheet called Master Table with columns A-CR. The Column I am searching is in column B. In the same workbook I have a spreadsheet called SearchMasterTable I am using cell C1 in this workbook for the input of the requested lookup.

If the data in SearchMasterTable cell C1 equals one or multiple records in workbook Master Table column B, I am trying to copy these records to the workbook SearchMasterTable starting with row 6.

The code runs but is not copying the data to the new worksheet.

Code:
Sub finddata()


Dim ApplicationNumber As String
Dim finalrow As Integer
Dim i As Integer
Dim LastRow As Long
Sheets("SearchMasterTable").Range("A6:CR506").ClearContents


ApplicationNumber = Sheets("SearchMasterTable").Range("C1").Value


finalrow = Sheets("Master Table").Range("A10000").End(xlUp).Row


For i = 2 To finalrow
If Cells(i, 2) = ApplicationNumber Then
    'Sheets("Master Table").Range(Cells(i, 1), Cells(i, 96)).Copy
    'Sheets("SearchMasterTable").Range("A6").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    Application.ScreenUpdating = False
    LastRow = Sheets("Master Table").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Master Table").Range("B8:B" & LastRow).AutoFilter Field:=2, Criteria1:="=ApplicationNumber"
    On Error Resume Next
    Sheets("Master Table").Range("B2:B" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("SearchMasterTable").Cells(Sheets("SearchMasterTable").Rows.Count, "A").End(xlUp).Offset(2, 0)
    On Error GoTo 0
    If Sheets("Master Table").AutoFilterMode = True Then Sheets("Master Table").AutoFilterMode = False
    Application.ScreenUpdating = True


    End If


Next i
Range("C1").Select




End Sub
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Firstly comment out the lines in red
Code:
Sub finddata()


Dim ApplicationNumber As String
Dim finalrow As Integer
Dim i As Integer
Dim LastRow As Long
Sheets("SearchMasterTable").Range("A6:CR506").ClearContents


ApplicationNumber = Sheets("SearchMasterTable").Range("C1").Value


finalrow = Sheets("Master Table").Range("A10000").End(xlUp).Row


[COLOR=#ff0000]For i = 2 To finalrow
If Cells(i, 2) = ApplicationNumber Then[/COLOR]
    'Sheets("Master Table").Range(Cells(i, 1), Cells(i, 96)).Copy
    'Sheets("SearchMasterTable").Range("A6").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    Application.ScreenUpdating = False
    LastRow = Sheets("Master Table").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Master Table").Range("B8:B" & LastRow).AutoFilter Field:=2, Criteria1:="=ApplicationNumber"
    On Error Resume Next
    Sheets("Master Table").Range("B2:B" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("SearchMasterTable").Cells(Sheets("SearchMasterTable").Rows.Count, "A").End(xlUp).Offset(2, 0)
    On Error GoTo 0
    If Sheets("Master Table").AutoFilterMode = True Then Sheets("Master Table").AutoFilterMode = False
    Application.ScreenUpdating = True


[COLOR=#ff0000]    End If


Next i[/COLOR]
Range("C1").Select




End Sub
You don't need them.
Then step through the code using F8 & when it applies the filter, are there any visible rows?
 
Upvote 0
Hey Fluff always great to hear from you. As always thanks for helping. As I step through I get to Sheets("Master Table").Range("B8:B" & LastRow).AutoFilter Field:=2, Criteria1:="=ApplicationNumber" and the next F8 gives me an AutoFilter method of Range class failed.

Still nothing moving to the new sheet yet.
 
Upvote 0
Ok, try changing this
Code:
Sheets("Master Table").Range("B8:B" & LastRow).AutoFilter Field:=1, Criteria1:=ApplicationNumber
Your only selecting one column, so it doesn't like field=2
 
Last edited:
Upvote 0
Okay this at least moves data to the correct worksheet. But not based on the value in SearchMasterTable cell C1. It is only moving the data from Master Table row B8. I have re-entered the code to catch up on the changes
Code:
Sub finddata()
Dim ApplicationNumber As String
Dim finalrow As Integer
Dim i As Integer
Dim LastRow As Long
Sheets("SearchMasterTable").Range("A6:CR506").ClearContents
ApplicationNumber = Sheets("SearchMasterTable").Range("C1").Value
finalrow = Sheets("Master Table").Range("A10000").End(xlUp).Row

        Application.ScreenUpdating = False
    LastRow = Sheets("Master Table").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Master Table").Range("B8:B" & LastRow).AutoFilter Field:=1, Criteria1:="=ApplicationNumber"
    On Error Resume Next
    Sheets("Master Table").Range("B8:B" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("SearchMasterTable").Cells(Sheets("SearchMasterTable").Rows.Count, "A").End(xlUp).Offset(2, 0)
    On Error GoTo 0
    If Sheets("Master Table").AutoFilterMode = True Then Sheets("Master Table").AutoFilterMode = False
    Application.ScreenUpdating = True

Range("C1").Select
End Sub
 
Last edited by a moderator:
Upvote 0
You haven't changed the criteria
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
Dang quotes get me every time, you would think I would learn! :). I was getting a blank row at the top so I changed the offset from 2 to 1 and that seemed to fix that issue. For some reason it is always copying the top row (8) from the Master Table in Row 6 on my target sheet (searchmastertable). Rows 7 on have the correct data in them.
 
Last edited:
Upvote 0
If you don't want row 8 copied over, make this change
Code:
Sheets("Master Table").Range("B[COLOR=#ff0000]9[/COLOR]:B" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("SearchMasterTable").Cells(Sheets("SearchMasterTable").Rows.Count, "A").End(xlUp).Offset(2, 0)
 
Upvote 0

Forum statistics

Threads
1,213,520
Messages
6,114,101
Members
448,548
Latest member
harryls

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