Find and return multiple value from a worksheet to another worksheet and move to next search criteria

P

priisha

New Member
Joined
Apr 4, 2022
Messages
22
Office Version
  1. 2016
Platform
  1. Windows
Hi,
I've been trying to find a way to look up a value from a list and return all entries from another worksheet, and when it's found it will move to another search criteria and repeat the same. Tried to use the index - array and small function but it will only return the first search criteria.

Tried to look for a VBA code but couldnt find one that matches what I'm looking for.

I have two worksheets
1) Result
2) Data (more than 50000 entries)

In the worksheet Result in column V I have search entries that I want to lookup, in column W I can see how many times this entry have been repeated in the worksheet Data
What I want the VBA to do is to look up the search criteria in column V (i.e cell V2) in worksheet Data and copy the enire row from column D in worksheet Data to the worksheet Result starting from A2 and repeat until all entries are found. When this is done the VBA will look up the entries for the next search criteria in column V (i.e cell V3) and continue until as long as value in column V>0 (because the value in column V is formula)
Result.png


result1.png


If the VBA works correctly the result should look like this

solution.png


Many thanks in advance for the help!
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Sort by date Sort by votes
try this:
VBA Code: 
Sub testt()
Dim outarr
With Worksheets("Data")
lastrow = .Cells(Rows.Count, "D").End(xlUp).Row
datar = .Range(.Cells(1, 4), .Cells(lastrow, 7))
End With
With Worksheets("Result")
lastdoc = .Cells(Rows.Count, "V").End(xlUp).Row
docar = .Range(.Cells(1, 22), .Cells(lastdoc, 23))

ReDim outarr(1 To lastrow, 1 To 4) ' define outarr as large as maximum possible
indi = 2
For i = 2 To lastdoc
 docnt = 0
 For j = 2 To lastrow
   If docar(i, 1) = datar(j, 1) Then ' copy
     For k = 1 To 4
      outarr(indi, k) = datar(j, k)
     Next k
     indi = indi + 1
     docnt = docnt + 1
     If docnt = docar(i, 2) Then Exit For
   End If
 Next j
Next i
 .Range(.Cells(2, 1), .Cells(indi, 4)) = outarr
End With
End Sub
 
Upvote 0
Solution
Another option using Autofilter to copy:

VBA Code: 
Option Explicit
Sub priisha()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Result")
    Set ws2 = Worksheets("Data")
    Dim c As Range
    Dim lr1 As Long, lr2 As Long, lr3 As Long
    lr1 = ws1.Cells(Rows.Count, 22).End(xlUp).Row
    lr2 = ws2.Cells(Rows.Count, 4).End(xlUp).Row
    
    For Each c In ws1.Range(ws1.Cells(2, 22), ws1.Cells(lr1, 22))
        lr3 = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
        With ws2.Range(ws2.Cells(2, 4), ws2.Cells(lr2, 7))
            .AutoFilter 1, c.Value
            .Offset(1).Copy ws1.Cells(lr3, 1)
            .AutoFilter
        End With
        lr3 = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Next c
End Sub

Data sheet used to test code (Description numbers arbitrary)
priisha.xlsb
BCDEFG
1
2YearMonthDoc nrPosting dateAccountDescription
32022Feb322022492022-02-02650021288300
42022Feb322022492022-02-02244021288301
52022Feb322022492022-02-02261721288302
62022Feb322022492022-02-02264721288303
72022Feb322022512022-02-02583221288304
82022Feb322022512022-02-02583221288305
92022Feb322022512022-02-02244321288306
102022Feb322022512022-02-02264621288307
112022Feb322022902022-02-03506021288308
122022Feb322022902022-02-03244021288309
132022Feb322022902022-02-03264021288310
142022Feb322022912022-02-03506021288311
152022Feb322022912022-02-03244021288312
162022Feb322022912022-02-03264021288313
172022Feb322029362022-02-06244321288314
182022Feb322029362022-02-06264621288315
192022Feb322029362022-02-06653021288316
Data


Result sheet before code is run
priisha.xlsb
ABCDEUVW
1Doc nrPosting dateAccountDescriptionDoc nrRepeat
2322022514
3322029363
4
5
6
7
8
Result
Cell Formulas
RangeFormula
W2:W3W2=COUNTIF(Data!D:D,Result!V2)
Named Ranges
NameRefers ToCells
Data!_FilterDatabase=Data!$D$2:$G$19W2:W3


Result sheet after code is run
priisha.xlsb
ABCDEUVW
1Doc nrPosting dateAccountDescriptionDoc nrRepeat
2322022512022-02-02583221288304322022514
3322022512022-02-02583221288305322029363
4322022512022-02-02244321288306
5322022512022-02-02264621288307
6322029362022-02-06244321288314
7322029362022-02-06264621288315
8322029362022-02-06653021288316
Result
Cell Formulas
RangeFormula
W2:W3W2=COUNTIF(Data!D:D,Result!V2)
Named Ranges
NameRefers ToCells
Data!_FilterDatabase=Data!$D$2:$G$19W2:W3
 
Upvote 0
offthelip said:
try this:
VBA Code: 
Sub testt()
Dim outarr
With Worksheets("Data")
lastrow = .Cells(Rows.Count, "D").End(xlUp).Row
datar = .Range(.Cells(1, 4), .Cells(lastrow, 7))
End With
With Worksheets("Result")
lastdoc = .Cells(Rows.Count, "V").End(xlUp).Row
docar = .Range(.Cells(1, 22), .Cells(lastdoc, 23))

ReDim outarr(1 To lastrow, 1 To 4) ' define outarr as large as maximum possible
indi = 2
For i = 2 To lastdoc
 docnt = 0
 For j = 2 To lastrow
   If docar(i, 1) = datar(j, 1) Then ' copy
     For k = 1 To 4
      outarr(indi, k) = datar(j, k)
     Next k
     indi = indi + 1
     docnt = docnt + 1
     If docnt = docar(i, 2) Then Exit For
   End If
 Next j
Next i
 .Range(.Cells(2, 1), .Cells(indi, 4)) = outarr
End With
End Sub
Click to expand...
Many thanks for the code, I tried to use this one but the Macro wouldn't run
 
Upvote 0
I tried to use this one but the Macro wouldn't run
Click to expand...
This doesn't give me any clue as to what happened, was there an error?? did the macro execute but copy nothing?? Have you tried using the VBA debug facility to see what happened??
 
Upvote 0
offthelip said:
This doesn't give me any clue as to what happened, was there an error?? did the macro execute but copy nothing?? Have you tried using the VBA debug facility to see what happened??
Click to expand...
Hi,
The problem is that it seems the macro wont start at all and no error popped up.

I tried to use the VBA debug facility and it runs through the code without error and until the part Next j and loops back to If docar(i, 1) = datar(j, 1) Then ' copy.
Assuming that it runs correctly it should after 4 repeats (because that's the amount of entries for the first criteria) it should go to Next i but it didn't happen
 
Upvote 0
kevin9999 said:
Another option using Autofilter to copy:

VBA Code: 
Option Explicit
Sub priisha()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Result")
    Set ws2 = Worksheets("Data")
    Dim c As Range
    Dim lr1 As Long, lr2 As Long, lr3 As Long
    lr1 = ws1.Cells(Rows.Count, 22).End(xlUp).Row
    lr2 = ws2.Cells(Rows.Count, 4).End(xlUp).Row
   
    For Each c In ws1.Range(ws1.Cells(2, 22), ws1.Cells(lr1, 22))
        lr3 = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
        With ws2.Range(ws2.Cells(2, 4), ws2.Cells(lr2, 7))
            .AutoFilter 1, c.Value
            .Offset(1).Copy ws1.Cells(lr3, 1)
            .AutoFilter
        End With
        lr3 = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Next c
End Sub

Data sheet used to test code (Description numbers arbitrary)
priisha.xlsb
BCDEFG
1
2YearMonthDoc nrPosting dateAccountDescription
32022Feb322022492022-02-02650021288300
42022Feb322022492022-02-02244021288301
52022Feb322022492022-02-02261721288302
62022Feb322022492022-02-02264721288303
72022Feb322022512022-02-02583221288304
82022Feb322022512022-02-02583221288305
92022Feb322022512022-02-02244321288306
102022Feb322022512022-02-02264621288307
112022Feb322022902022-02-03506021288308
122022Feb322022902022-02-03244021288309
132022Feb322022902022-02-03264021288310
142022Feb322022912022-02-03506021288311
152022Feb322022912022-02-03244021288312
162022Feb322022912022-02-03264021288313
172022Feb322029362022-02-06244321288314
182022Feb322029362022-02-06264621288315
192022Feb322029362022-02-06653021288316
Data


Result sheet before code is run
priisha.xlsb
ABCDEUVW
1Doc nrPosting dateAccountDescriptionDoc nrRepeat
2322022514
3322029363
4
5
6
7
8
Result
Cell Formulas
RangeFormula
W2:W3W2=COUNTIF(Data!D:D,Result!V2)
Named Ranges
NameRefers ToCells
Data!_FilterDatabase=Data!$D$2:$G$19W2:W3


Result sheet after code is run
priisha.xlsb
ABCDEUVW
1Doc nrPosting dateAccountDescriptionDoc nrRepeat
2322022512022-02-02583221288304322022514
3322022512022-02-02583221288305322029363
4322022512022-02-02244321288306
5322022512022-02-02264621288307
6322029362022-02-06244321288314
7322029362022-02-06264621288315
8322029362022-02-06653021288316
Result
Cell Formulas
RangeFormula
W2:W3W2=COUNTIF(Data!D:D,Result!V2)
Named Ranges
NameRefers ToCells
Data!_FilterDatabase=Data!$D$2:$G$19W2:W3
Click to expand...
Hi,

thank you for the code, I tried this VBA and it worked fine on my test sheet.
However I forgot to mention that in the real file the worksheet Data is a powerpivot table. And when I copied the VBA code you've provided I got an error when the code moves from
.Autofilter 1, c.Value to
.Offset(1).Copy ws1.Cells(lr3, 1)

Error message
Run-time error 1004'
Application-defined or object-defined error.

thanks!
 

Attachments

  • 111.png
    111.png
    3.3 KB · Views: 9
Upvote 0
It would appear that the values which the code is checking in docar(i,1) and data(j,1) never match. I sugggest you put a breakpoint on that line of code and see what the values in these two are. To put a breakpoint in just click on the column next the line in the vba window.,
 
Upvote 0
offthelip said:
It would appear that the values which the code is checking in docar(i,1) and data(j,1) never match. I sugggest you put a breakpoint on that line of code and see what the values in these two are. To put a breakpoint in just click on the column next the line in the vba window.,
Click to expand...
many thanks for the support, solved the issue by changing For j = 2 to For j = 3.
 
Upvote 0
However I forgot to mention that in the real file the worksheet Data is a powerpivot table.
Click to expand...
Yes, it would have been useful to know this from the start ;)

It seems from your post #9 that you have a solution with the code supplied by @offthelip. Sorry I couldn't help further.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
VBA Search box and button code
Replies
0
Views
247
jlcodes
J
J
  • Solved
Search/Filter a Spreadsheet by User Entered Value
Replies
3
Views
136
jbennett01
J
T
  • Solved
Replace Word in Cell with Value from Another Cell
2
Replies
10
Views
583
Akuini
Akuini
B
  • Question Question
Find and match partial text between 2 tables, return value
Replies
0
Views
170
BudgetGirl
B
M
  • Question Question
Paste to Headers
Replies
1
Views
165
mumps
mumps

Forum statistics

Threads
1,223,889
Messages
6,175,224
Members
452,620
Latest member
dsubash

Share this page

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