Copy data to another sheet based on supplier number and given dates

FariAb

New Member
Joined
Jul 20, 2022
Messages
13
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
Hi everyone, I have an Excel sheet that currently looks something like this:


I'd like to enter a supplier number and a date range in a sheet (example below) and that the data that fulfills the criteria is copied to a new sheet


So let's say, I enter supplier number "00X12345" and From 23/08/2022 to 27/08/2022, so it'd copy this data:


Does anyone know if this would be possible using VBA?

Thank you in advance.
 

Attachments

  • 1663881713534.png
    1663881713534.png
    5.1 KB · Views: 6
  • 1663881729892.png
    1663881729892.png
    1.8 KB · Views: 5
  • 1663881862156.png
    1663881862156.png
    2.1 KB · Views: 6

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Yes it can.

Assuming you have:
* The filter criteria in worksheet "FILTER FOR SUPPLIER"
* The supplier data in "SUPPLIER" worksheet
* The result in "RESULT" worksheet
* The "DATELIST" worksheet - for referencing the date to the column reference

For the SUPPLIER data, I assume that you have more Dates than shown in your sample.
1663898172111.png


The DATELIST data:
1663898676910.png


And your FILTER FOR SUPPLIER worksheet:
1663898975392.png

(In column E, I show the row number, and in column F, I show the variable used to capture and store the information entered into the cells)

For the FILTER FOR SUPPLIER function, I assume that you will only search and copy 1 supplier at a time.

The GO button will be linked to the VBA code modCopySupplier:

VBA Code:
Option Explicit
Option Compare Text

Sub modCopySupplier()
'===================================
'   Search and copy supplier data
'   for the date range specified
'===================================
Dim lngRow          As Long
Dim lngLasRow       As Long

Dim WB              As Workbook
Dim wsFilter        As Worksheet
Dim wsSupp          As Worksheet
Dim wsResult        As Worksheet
Dim wsDateList      As Worksheet

Dim txtSupplier     As String
Dim dtDateFrom      As Date
Dim dtDateTo        As Date
Dim lngDateRow      As Long
Dim lngLasDateRow   As Long

Dim ColFrom         As String
Dim ColTo           As String

    '==========================================================
    '   Positively identify this workbook and its worksheets
    '   then you can refer the worksheets by the nickname
    '==========================================================
    Set WB = ActiveWorkbook     'This workbook
    Set wsFilter = WB.Sheets("FILTER FOR SUPPLIER")
    Set wsSupp = WB.Sheets("SUPPLIER")
    Set wsResult = WB.Sheets("RESULT")
    Set wsDateList = WB.Sheets("DATELIST")
    
    '====================================================
    '   Clean out any old data in the RESULT worksheet
    '====================================================
    wsResult.Cells.ClearContents
    
    '===================
    '   Get the input
    '===================
    txtSupplier = Trim(wsFilter.Range("C2"))
    dtDateFrom = wsFilter.Range("C4")
    dtDateTo = wsFilter.Range("C6")
    
        '====================================================
        '   Error trap: If any of the data cells are blank
        '====================================================
        If txtSupplier = "" Or _
           dtDateFrom = 0 Or _
           dtDateTo = 0 Then
           '=========================================
           '   Show error message on the StatusBar
           '   (bottom left of screen)
           '=========================================
           Application.StatusBar = "Information is not complete!"
           '==========
           '   Quit
           '==========
           Exit Sub
        End If

'--------------------------------------------------
'   Assume that the inputs are correct,
'   we can now begin to search and copy the data
'--------------------------------------------------
    
    '========================================================
    '   First, find the last data row in the SUPPLIER list
    '   so the program knows when to stop searching
    '========================================================
    lngLasRow = wsSupp.Range("A1048576").End(xlUp).row
        '================================================
        '   Now we search for the supplier
        '   by comparing the txtSupplier with column A
        '   in the SUPPLIER worksheet
        '================================================
        For lngRow = 2 To lngLasRow
            '===================================================
            '   Compare txtSupplier with the data in column A
            '===================================================
            If txtSupplier = wsSupp.Range("A" & lngRow) Then
                '===================================================
                '   Found the Supplier in this row
                '   write this in the RESULTS worksheet, column A
                '===================================================
                wsResult.Range("A1") = "SUPPLIER"
                wsResult.Range("A2") = wsSupp.Range("A" & lngRow)
                    '===============================================
                    '   Next, we are going to search the DateList
                    '   So we find the last data row
                    '===============================================
                    lngLasDateRow = wsDateList.Range("A1048576").End(xlUp).row
                    '==============================================
                    '   Now we have to find the column reference
                    '   for the first and second dates.
                    '   First, let's find the first date
                    '==============================================
                    For lngDateRow = 2 To lngLasDateRow
                        '=========================
                        '   Find the first date
                        '=========================
                        If wsDateList.Range("A" & lngDateRow) = dtDateFrom Then
                            '==============================
                            '   Found the first date.
                            '   Get the column reference
                            '==============================
                            ColFrom = wsDateList.Range("B" & lngDateRow)
                            Exit For
                        End If
                    Next
                    '======================================
                    '   Next, let's find the second date
                    '======================================
                    For lngDateRow = 2 To lngLasDateRow
                        '==========================
                        '   Find the second date
                        '==========================
                        If wsDateList.Range("A" & lngDateRow) = dtDateTo Then
                            '==============================
                            '   Found the first date.
                            '   Get the column reference
                            '==============================
                            ColTo = wsDateList.Range("B" & lngDateRow)
                            Exit For
                        End If
                    Next
                '===================
                '   Stop checking
                '===================
                Exit For
            End If
        Next
    
    '===========================================
    '   Finally, copy the data from SUPPLIER
    '   by copying the date headings
    '   and the supplier data
    '===========================================
    wsResult.Activate
    
    wsSupp.Range(ColFrom & "1:" & ColTo & "1").Copy
    wsResult.Range("B1").PasteSpecial xlPasteValues
    
    wsSupp.Range(ColFrom & lngRow & ":" & ColTo & lngRow).Copy
    wsResult.Range("B2").PasteSpecial xlPasteValues
    
    wsResult.Columns.AutoFit
    wsResult.Range("A3").Select
    
End Sub

Hope this helps.
 

Attachments

  • 1663898743857.png
    1663898743857.png
    14.3 KB · Views: 1
Upvote 0
Solution
Yes it can.

Assuming you have:
* The filter criteria in worksheet "FILTER FOR SUPPLIER"
* The supplier data in "SUPPLIER" worksheet
* The result in "RESULT" worksheet
* The "DATELIST" worksheet - for referencing the date to the column reference

For the SUPPLIER data, I assume that you have more Dates than shown in your sample.
View attachment 74590

The DATELIST data:
View attachment 74591

And your FILTER FOR SUPPLIER worksheet:
View attachment 74594
(In column E, I show the row number, and in column F, I show the variable used to capture and store the information entered into the cells)

For the FILTER FOR SUPPLIER function, I assume that you will only search and copy 1 supplier at a time.

The GO button will be linked to the VBA code modCopySupplier:

VBA Code:
Option Explicit
Option Compare Text

Sub modCopySupplier()
'===================================
'   Search and copy supplier data
'   for the date range specified
'===================================
Dim lngRow          As Long
Dim lngLasRow       As Long

Dim WB              As Workbook
Dim wsFilter        As Worksheet
Dim wsSupp          As Worksheet
Dim wsResult        As Worksheet
Dim wsDateList      As Worksheet

Dim txtSupplier     As String
Dim dtDateFrom      As Date
Dim dtDateTo        As Date
Dim lngDateRow      As Long
Dim lngLasDateRow   As Long

Dim ColFrom         As String
Dim ColTo           As String

    '==========================================================
    '   Positively identify this workbook and its worksheets
    '   then you can refer the worksheets by the nickname
    '==========================================================
    Set WB = ActiveWorkbook     'This workbook
    Set wsFilter = WB.Sheets("FILTER FOR SUPPLIER")
    Set wsSupp = WB.Sheets("SUPPLIER")
    Set wsResult = WB.Sheets("RESULT")
    Set wsDateList = WB.Sheets("DATELIST")
   
    '====================================================
    '   Clean out any old data in the RESULT worksheet
    '====================================================
    wsResult.Cells.ClearContents
   
    '===================
    '   Get the input
    '===================
    txtSupplier = Trim(wsFilter.Range("C2"))
    dtDateFrom = wsFilter.Range("C4")
    dtDateTo = wsFilter.Range("C6")
   
        '====================================================
        '   Error trap: If any of the data cells are blank
        '====================================================
        If txtSupplier = "" Or _
           dtDateFrom = 0 Or _
           dtDateTo = 0 Then
           '=========================================
           '   Show error message on the StatusBar
           '   (bottom left of screen)
           '=========================================
           Application.StatusBar = "Information is not complete!"
           '==========
           '   Quit
           '==========
           Exit Sub
        End If

'--------------------------------------------------
'   Assume that the inputs are correct,
'   we can now begin to search and copy the data
'--------------------------------------------------
   
    '========================================================
    '   First, find the last data row in the SUPPLIER list
    '   so the program knows when to stop searching
    '========================================================
    lngLasRow = wsSupp.Range("A1048576").End(xlUp).row
        '================================================
        '   Now we search for the supplier
        '   by comparing the txtSupplier with column A
        '   in the SUPPLIER worksheet
        '================================================
        For lngRow = 2 To lngLasRow
            '===================================================
            '   Compare txtSupplier with the data in column A
            '===================================================
            If txtSupplier = wsSupp.Range("A" & lngRow) Then
                '===================================================
                '   Found the Supplier in this row
                '   write this in the RESULTS worksheet, column A
                '===================================================
                wsResult.Range("A1") = "SUPPLIER"
                wsResult.Range("A2") = wsSupp.Range("A" & lngRow)
                    '===============================================
                    '   Next, we are going to search the DateList
                    '   So we find the last data row
                    '===============================================
                    lngLasDateRow = wsDateList.Range("A1048576").End(xlUp).row
                    '==============================================
                    '   Now we have to find the column reference
                    '   for the first and second dates.
                    '   First, let's find the first date
                    '==============================================
                    For lngDateRow = 2 To lngLasDateRow
                        '=========================
                        '   Find the first date
                        '=========================
                        If wsDateList.Range("A" & lngDateRow) = dtDateFrom Then
                            '==============================
                            '   Found the first date.
                            '   Get the column reference
                            '==============================
                            ColFrom = wsDateList.Range("B" & lngDateRow)
                            Exit For
                        End If
                    Next
                    '======================================
                    '   Next, let's find the second date
                    '======================================
                    For lngDateRow = 2 To lngLasDateRow
                        '==========================
                        '   Find the second date
                        '==========================
                        If wsDateList.Range("A" & lngDateRow) = dtDateTo Then
                            '==============================
                            '   Found the first date.
                            '   Get the column reference
                            '==============================
                            ColTo = wsDateList.Range("B" & lngDateRow)
                            Exit For
                        End If
                    Next
                '===================
                '   Stop checking
                '===================
                Exit For
            End If
        Next
   
    '===========================================
    '   Finally, copy the data from SUPPLIER
    '   by copying the date headings
    '   and the supplier data
    '===========================================
    wsResult.Activate
   
    wsSupp.Range(ColFrom & "1:" & ColTo & "1").Copy
    wsResult.Range("B1").PasteSpecial xlPasteValues
   
    wsSupp.Range(ColFrom & lngRow & ":" & ColTo & lngRow).Copy
    wsResult.Range("B2").PasteSpecial xlPasteValues
   
    wsResult.Columns.AutoFit
    wsResult.Range("A3").Select
   
End Sub

Hope this helps.
Thank you so much!! Worked like a charm
 
Upvote 0

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

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