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

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
It's simply copying from row 9, rather than row 8
 
Upvote 0
Hey Fluff I hope all is well. I haven't had much time to work with this lately. The code you provided above works fine, but I need Row 8 to be part of the data which is searched. If I change the code to:

Rich (BB code):
Sheets("Master Table").Range("B8:B" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("SearchMasterTable").Cells(Sheets("SearchMasterTable").Rows.Count, "A").End(xlUp).Offset(1, 0)

It always includes Row 8 in the returned data. If I search on the Application # in Row 8 on the Master Table I get a request to save the spreadsheet. If I cancel it displays the correct data. Very strange.

Any ideas?

Here is the whole code as it currently is:

Rich (BB 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(1, 0)
    On Error GoTo 0
    If Sheets("Master Table").AutoFilterMode = True Then Sheets("Master Table").AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Sounds like you have some event code running.
Have a look in the sheet module of Master Table & also lookin ThisWorkbook module
 
Upvote 0

Forum statistics

Threads
1,223,991
Messages
6,175,821
Members
452,672
Latest member
missbanana

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