Copy rows from dataset with data input on one sheet based on another sheet's criteria. [VBA]

Itzybell

New Member
Joined
Jul 15, 2019
Messages
7
Hi all,
I have 3 sheets:
"Input","dataset","Print"

My objective is to input a few data in "input" Column A and run the macro.
If any cell in Column A of "Dataset" = "input" Column A,
it will print out the whole row results to "Print".

I found many examples of copying rows into another sheet,
however, it is mostly all coded based on the cell value.
My cell value will not be constant therefore I want the macro to look based on Column A instead.

Here is how the dataset looks like:
1579796199837.png


I did some research and i did found a VBA code that works after some modification,
but it is taking too long to search every data in the cells.
It is also looking at a limited range in Column A instead of the whole Column A:

VBA Code:
Sub Copy()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim Condition As Worksheet


    Set Source = ActiveWorkbook.Worksheets("Dataset")
    Set Target = ActiveWorkbook.Worksheets("Print")
    Set Condition = ActiveWorkbook.Worksheets("Input")

    j = 1    'This will start copying data to Target sheet at row 1
      For Each d In Condition.Range("A5:A86")
        For Each c In Source.Range("A1:A86")
            If d = c Then
                Source.Rows(c.Row).Copy Target.Rows(j)
                j = j + 1
            End If
        Next c
      Next d

 
End Sub

I would appreciate if someone could help me in this!
Many thanks! :)
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
How about
VBA Code:
Sub Itzybell()
   Dim Cl As Range, Rng As Range
   Dim Source As Worksheet, Target As Worksheet, Condition As Worksheet

   Set Source = ActiveWorkbook.Worksheets("Dataset")
   Set Target = ActiveWorkbook.Worksheets("Print")
   Set Condition = ActiveWorkbook.Worksheets("Input")
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Condition.Range("A2", Condition.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Empty
      Next Cl
      For Each Cl In Source.Range("A2", Source.Range("A" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
         End If
      Next Cl
      If Not Rng Is Nothing Then Rng.EntireRow.Copy Target.Range("A1")
   End With
End Sub
 
Upvote 0
Another
Code:
Sub t()
 Dim Source As Worksheet, Target As Worksheet, Condition As Worksheet, c As Range, fn As Range
 Set Source = ActiveWorkbook.Worksheets("Dataset")
 Set Target = ActiveWorkbook.Worksheets("Print")
 Set Condition = ActiveWorkbook.Worksheets("Input")
    For Each c In Condition.Range("A5", Condition.Cells(Rows.Count, 1).End(xlUp))
        Set fn = Source.Range("A:A").Find(c.Value, , xlValues)
            If Not fn Is Nothing Then
                fn.EntireRow.Copy Target.Cells(Rows.Count, 1).End(xlUp)(2)
            End If
    Next
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,185
Members
448,554
Latest member
Gleisner2

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