Data import with Filter

truckingalong · Mar 30th 2023

I am struggling with this code, can seem to get it right. Can anyone help?

I have a spread sheet I use to cost track jobs by the PO #, Im trying to create a macro i can run at will to automate the data transfer.

Macro has to open a source workbook, search all of the worksheets for each occurrence of the PO# Range(A2) in the activesheet, each time it finds the PO copy the data from Col B, Col A, and Col K, paste that data back to the active sheet starting in the first available row of Col A

Code

Sub CopyData()
Dim ws As Worksheet, wb As Workbook
Dim searchValue As Variant
Dim rng As Range, cell As Range
Dim lastRow As Long

Set ws = ActiveSheet
searchValue = ws.Range("A2").Value

Set wb = Workbooks.Open("\\DATASERVER\data\DAILY SPREADSHEETS\Job Tickets\Job Ticket Log.xlsm")

Set rng = wb.Worksheets(3).Range("A:K").Find(searchValue, LookIn:=xlValues, LookAt:=xlWhole)

    If Not rng Is Nothing Then
        Do
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
            rng.Offset(0, 11).Resize(1, 1).Copy
            ws.Cells(lastRow, "A").PasteSpecial xlPasteValuesAndNumberFormats
            rng.Offset(0, 0).Resize(1, 1).Copy
            ws.Cells(lastRow, "B").PasteSpecial xlPasteValuesAndNumberFormats
            rng.Offset(0, 2).Resize(1, 1).Copy
            ws.Cells(lastRow, "C").PasteSpecial xlPasteValuesAndNumberFormats
            Set rng = wb.Worksheets(3).Range("A:K").FindNext(rng)
        Loop While Not rng Is Nothing And rng.Address <> wb.Worksheets(3).Range("A:K").Find(searchValue, LookIn:=xlValues, LookAt:=xlWhole).Address
    End If
Application.CutCopyMode = False
wb.Close SaveChanges:=False
End Sub

Display More

**Carim** · Mar 31st 2023

Hi,

Could you clarify the structure of workbook Job Ticket Log.xlsm

Are you dealing with one or several worksheets ?

Where can be located your searchvalue ? In column A or anywhere in the sheet (or the sheets...) ?

Thanks for your clarifications

P.S. Do not forget images are dead objects rather useless ... and attaching a sample file makes a huge difference ...!!!

truckingalong · Mar 31st 2023

Carim,

Thanks for your reply, I will try to lay out our system for you.

I created a job ticket to replace the paper tickets the company was previously using. The job ticket has macros to perform several automations, including

saving particular fields into a Job Ticket Log. I use the log to verify tickets, have a historical record of jobs completed by the month and year, and to track hours worked by certain groups. Job ticket log has a sheet named Data where everything is stored after a job ticket is completed. Job ticket log creates a new sheet named with the current month and year on the first day of each month, I cut and paste all the data from sheet (data) to the correct months sheet after I have verified the tickets.

Funding workbook is where I track PO's for a particular customer, I enter all PO's into a list sheet (PO list), from there I can go to sheet (Master), and select the PO number from a drop down list, it auto populates data from the list sheet. Use the new sheet button, and it saves the sheet and clears the master template. Now to the point of the code...

I wrote the code so after I have a PO sheet opened (active sheet) , I can run the copy data macro to open job ticket log workbook, look through all of the the sheets for the PO number (cell A2) in active sheet, it will always be in column I. Each time it finds the PO number, loop should move values and formats to funding workbook in which ever sheet you have active. Macro needs to place data in next available row beginning with cell A6, add rows if necessary would be nice.

I would appreciate any help your willing to provide..

Thanks

see samples attached

1. Job ticket

2. Job ticket Log

3 Macro test ( Funding Workbook)

**Carim** · Mar 31st 2023

Hi again,

Just read your message extremely well structured ...!!!

And my initial reaction is to send you all my congratulations for all the work you have already accomplished ...

As soon as I have a moment, I will dive into the specifics of your workbooks, and get back to you as soon as possible ...

truckingalong · Mar 31st 2023

Thanks!

**Carim** · Apr 2nd 2023

Hi,

There are several questions to tackle :

1. Regarding Job Ticket Numbers ... shouldn't they be Unique ? ( #204123 appears twice in Rows 191 and 192 ... )

2. Your current CopyData macro, when searching for the Purchase Order Number is coded to use Column A ... but the Purchase Order Number is located in Column I ...

3. By design, each Purchase Order Number can have one of several Job Ticket Numbers attached ...and your pre-formatted report does set a max limit to 7 potential links ... is that right ?

Thanks for your clarifications

truckingalong · Apr 3rd 2023

Morning,

1. Job numbers should definitely be unique, dispatcher saved the ticket twice. I audit log at the end of each month and make necessary corrections.

2. I thought it was coded to look through the whole sheet starting in column A, and ending in column K, although now that you mention it would make more sense only to look in column I.

3. I am not sure about the max 7 links,

truckingalong · Apr 3rd 2023

Carim,

I have adjusted to look only in column I, Still returning the wrong data sets to the wrong locations. I am returning amount to column A, and hours to column B, with no return to column C.

Data return should be

Column A Date

Column B Job Ticket number

Column C Amount

Where am I going Wrong?

**Carim** · Apr 3rd 2023

Thanks for your additional explanations which do help clarifying your request

**Carim** · Apr 3rd 2023

Hi again,

Below is your revised Copy Macro to be tested ...

Code

Sub CopyData()
' Ozgrid - truckingalong Apr.3 2023
Dim ws As Worksheet, wb As Workbook
Dim searchValue As Variant
Dim rng As Range, rw As Range
Dim lastrow As Long, destrow As Long
    
    Set ws = ActiveSheet
    searchValue = ws.Range("A2").Value

    Set wb = Workbooks.Open("\\DATASERVER\data\DAILY SPREADSHEETS\Job Tickets\Job Ticket Log.xlsm")

    ' Filter Purchase Order Number located in Column I
    lastrow = wb.Sheets("Data").Cells(Rows.count, "A").End(xlUp).Row
    wb.Sheets("Data").Range("A1:K" & lastrow).AutoFilter Field:=9, Criteria1:="=" & searchValue
    ' Define the Range of Visible Rows after Filter
    Set rng = wb.Sheets("Data").Range("A2:K" & lastrow).SpecialCells(xlCellTypeVisible)
        ' Loop through Filtered Visible rows
        For Each rw In rng
            destrow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row + 1
            ws.Cells(destrow, "A").Value = rng.Cells(rw, 2).Value
            ws.Cells(destrow, "B").Value = rng.Cells(rw, 1).Value
            ws.Cells(destrow, "C").Value = rng.Cells(rw, 11).Value  ' Column K is 11 - Not Column AS i.e. 45 '
        Next rw
    ' Remove Filter
    wb.Sheets("Data").Range("A1:K" & lastrow).AutoFilter
    ' Close Source Workbook
    wb.Close SaveChanges:=False
End Sub

Display More

Hope this will help

truckingalong · Apr 3rd 2023

Thanks for the reply

Macro is giving a runtime error 13 msimatch, see screen shot.

Is this only going to look at the sheet (DATA), or will it look through all of the sheets in the source workbook?

**Carim** · Apr 3rd 2023

My understanding is that you sheet Data is regrouping all your various monthly data ....

If it is not the case, would highly recommend not to carry on creating an individual tab for each month

BUT to keep track of ALL your Job Ticket Numbers stored in a one single worksheet Data ...

Regarding the macro runtime error, my assumption is that a Test to validate the Filter does produce results must be added to ensure macro does not generate errors...

truckingalong · Apr 3rd 2023

thanks for the help

**Carim** · Apr 4th 2023

You are welcome.

Will add the error handling in your macro and test it out ...

**Carim** · Apr 4th 2023

Hi again,

Below is your revised macro, which is checking (and counting) the number of visible records after filter has been applied, in order to avoid potential errors, whenever a given Purchase Order is not found in your reference Database :

Code

Option Explicit

Sub CopyDataV2()
' Ozgrid - truckingalong - modified on Apr.4 2023
' including Error Handling for Records after Filtering

Dim ws As Worksheet, wb As Workbook
Dim searchValue As Variant
Dim rng As Range, rw As Range
Dim lastrow As Long, destrow As Long
Dim NbVisibleRows As Long
    
    Set ws = ActiveSheet
    searchValue = ws.Range("A2").Value

    Set wb = Workbooks.Open("\\DATASERVER\data\DAILY SPREADSHEETS\Job Tickets\Job Ticket Log.xlsm")

    ' Filter Purchase Order Number located in Column I
    lastrow = wb.Sheets("Data").Cells(Rows.count, "A").End(xlUp).Row
    wb.Sheets("Data").Range("A1:K" & lastrow).AutoFilter Field:=9, Criteria1:="=" & searchValue
    
    ' Check the Number of Visible Rows 
    NbVisibleRows = -1
    On Error Resume Next
    NbVisibleRows = wb.Sheets("Data").Range("I2:I" & lastrow).SpecialCells(xlCellTypeVisible).count
    On Error GoTo 0
        If NbVisibleRows = -1 Then
            MsgBox " No Job Ticket Number for this Purchase Order ..."
            wb.Sheets("Data").Range("A1:K" & lastrow).AutoFilter
            Exit Sub
        Else
            ' If needed - Display Message Box with the Number of Job Tickets
            ' MsgBox NbVisibleRows & " Job Ticket Numbers for this Purchase Order"
        End If
    
    ' Define the Range of Visible Rows after Filter
      Set rng = wb.Sheets("Data").Range("A2:K" & lastrow).SpecialCells(xlCellTypeVisible)
    
     ' Since Filter has produced at least one record,
     ' Loop through Filtered Visible rows
     
     ' Couple of Remarks about the Final Report :
     ' Current format requires starting row number to be 6
     ' Current format imposes a Max Number of 7 items given Row 13 shows Total
       destrow = 6
         For Each rw In rng
            ws.Cells(destrow, "A").Value = rng.Cells(rw.Row, 2).Value
            ws.Cells(destrow, "B").Value = rng.Cells(rw.Row, 1).Value
            ws.Cells(destrow, "C").Value = rng.Cells(rw.Row, 11).Value   'Column K is 11 - NOT Column AS was 45
            destrow = destrow + 1
         Next rw
    
    ' Remove Filter in Source Workbook
    wb.Sheets("Data").Range("A1:K" & lastrow).AutoFilter
    ' Close Source Workbook
    wb.Close SaveChanges:=False
End Sub

Display More

Hope this will help

**Carim** · Apr 7th 2023

Hi,

Once you have tested the revised macro, feel free to share your comments

**Carim** · Apr 12th 2023

What is your feedback ... ???

truckingalong · Apr 12th 2023

Carim,

sorry for the late reply i have been out of the office. had to make a couple of tweaks, but it is working great.

Thanks for you help

**Carim** · Apr 13th 2023

Thanks for your feedback AND for the Like

Data import with Filter

Carim Apr 4th 2023

Participate now!

Share

Similar Threads

Looping through workbooks and copy pasting data between dates

Find the fault in the code

Help with VBA Code to rename column title

If WS 2 ID exists in WS 1, update WS 1 column value, else create new row with WS 2 data

struggling to modify steps in power query to import from url all pages

Copy specific cell data to summary tab based on tab name

Users Viewing This Thread