Copy Data to new Worksheet Based on Column Value

[slpswhite]

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.

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

 

[Fluff]

Firstly comment out the lines in red

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?

 

[slpswhite]

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.

 

[Fluff]

Ok, try changing this

Sheets("Master Table").Range("B8:B" & LastRow).AutoFilter Field:=1, Criteria1:=ApplicationNumber

Your only selecting one column, so it doesn't like field=2

 

[slpswhite]

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

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

 

[Fluff]

You haven't changed the criteria

 

[slpswhite]

Dang quotes kill me every time. Works perfect now. Thanks again.

 

[Fluff]

Glad to help & thanks for the feedback

 

[slpswhite]

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.

 

[Fluff]

If you don't want row 8 copied over, make this change

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)