How to compare two columns in different sheets - vba

I have one excel file with multiple sheets.
I need to compare two sheets (1) TotalList and (2) cList with more than 25 columns, in these two sheets columns are same.
On cList the starting row is 3
On TotalList the starting row is 5
Now, I have to compare the E & F columns from cList, with TotalList E & F columns, if it is not found then add the entire row at the end of TotalList sheet and highlight with Yellow.
Public Function compare()
Dim LoopRang As Range
Dim FoundRang As Range
Dim ColNam
Dim TotRows As Long
LeaData = "Shhet2"
ConsolData = "Sheet1"
TotRows = Worksheets(LeaData).Range("D65536").End(xlUp).Row
TotRows1 = Worksheets(ConsolData).Range("D65536").End(xlUp).Row
'TotRows = ThisWorkbook.Sheets(LeaData).UsedRange.Rows.Count
ColNam = "$F$3:$F" & TotRows
ColNam1 = "$F$5:$F" & TotRows1
For Each LoopRang In Sheets(LeaData).Range(ColNam)
Set FoundRang = Sheets(ConsolData).Range(ColNam1).Find(LoopRang, lookat:=xlWhole)
For Each FoundRang In Sheets(ConsolData).Range(ColNam1)
If FoundRang & FoundRang.Offset(0, -1) <> LoopRang & LoopRang.Offset(0, -1) Then
TotRows = Worksheets(ConsolData).Range("D65536").End(xlUp).Row
ThisWorkbook.Worksheets(LeaData).Rows(LoopRang.Row).Copy ThisWorkbook.Worksheets(ConsolData).Rows(TotRows + 1)
ThisWorkbook.Worksheets(ConsolData).Rows(TotRows + 1).Interior.Color = vbYellow
GoTo NextLine
End If
Next FoundRang
NextLine:
Next LoopRang
End Function
Please help with the VBA code.
Thanks in advance...

First I am going to give some general coding hints:
set Option Explicit ON. This is done through Tools > Options >
Editor (tab) > Require Variable Declaration . Now you HAVE to
declare all variables before you use them.
always declare a variables type when you declare it. If you are unsure about what to sue or if it can take different types (not advisable!!) use Variable.
Use a standard naming convention for all your variables. Mine is a string starts with str and a double with dbl a range with r, etc.. So strTest, dblProfit and rOriginal. Also give your variables MEANINGFUL names!
Give your Excel spreadsheets meanigful names or captions (caption is what you see in excel, name is the name you can directly refer to in VBA). Avoid using the caption, but refer to the name instead, as users can change the caption easily but the name only if they open the VBA window.
Ok so here is how a comparison between two tables can be done with your code as starting point:
Option Explicit
Public Function Compare()
Dim rOriginal As Range 'row records in the lookup sheet (cList = Sheet2)
Dim rFind As Range 'row record in the target sheet (TotalList = Sheet1)
Dim rTableOriginal As Range 'row records in the lookup sheet (cList = Sheet2)
Dim rTableFind As Range 'row record in the target sheet (TotalList = Sheet1)
Dim shOriginal As Worksheet
Dim shFind As Worksheet
Dim booFound As Boolean
'Initiate all used objects and variables
Set shOriginal = ThisWorkbook.Sheets("Sheet2")
Set shFind = ThisWorkbook.Sheets("Sheet1")
Set rTableOriginal = shOriginal.Range(shOriginal.Rows(3), shOriginal.Rows(shOriginal.Rows.Count).End(xlUp))
Set rTableFind = shFind.Range(shFind.Rows(5), shFind.Rows(shFind.Rows.Count).End(xlUp))
booFound = False
For Each rOriginal In rTableOriginal.Rows
booFound = False
For Each rFind In rTableFind.Rows
'Check if the E and F column contain the same information
If rOriginal.Cells(1, 5) = rFind.Cells(1, 5) And rOriginal.Cells(1, 6) = rFind.Cells(1, 6) Then
'The record is found so we can search for the next one
booFound = True
GoTo FindNextOriginal 'Alternatively use Exit For
End If
Next rFind
'In case the code is extended I always use a boolean and an If statement to make sure we cannot
'by accident end up in this copy-paste-apply_yellow part!!
If Not booFound Then
'If not found then copy form the Original sheet ...
rOriginal.Copy
'... paste on the Find sheet and apply the Yellow interior color
With rTableFind.Rows(rTableFind.Rows.Count + 1)
.PasteSpecial
.Interior.Color = vbYellow
End With
'Extend the range so we add another record at the bottom again
Set rTableFind = shFind.Range(rTableFind, rTableFind.Rows(rTableFind.Rows.Count + 1))
End If
FindNextOriginal:
Next rOriginal
End Function

Related

Excel loop condition based concatenation [duplicate]

This question already has answers here:
PowerQuery: How can I concatenate grouped values?
(3 answers)
Closed 4 years ago.
I am very new to excel macros and i need your help to fix one of my condition based concatenation problem.
i will explain the problem with simple scenario in below:
In my sheet , Column A contains customer name and Column B contains country names. Attached excel screenprint for reference ( column C and Column D will be my expected results)
In the column A, single customer name can be repeated as he can have multiple country representations
In the column B, countries placed as shown in the screenprint.
My expected results will be look alike in the column C and D as shown in the image.
I can do the column C using INDEX and i am able to get the unique values from column A
For the column D ,i am expecting the results in such a way that all countries will be concatenated and separated by ' / ' based on the corresponding customer in column A. I tried some vlookups and indexes, but i am unable
to do it.
it would be really helpful if you could provide any suggestions(function/Macros) how it will be achieved.
I am a lower intermediate vba user, so I will admit that I am sure someone can do this better than , however, this works. Add a button and then click on it, or add this to the worksheet and it will occur whenever you choose for it to be fired:
Option Explicit
Sub listout()
'declare your variables
Dim wbk As Workbook
Dim ws1 As Worksheet
Dim cprange As Range
Dim rmrange As Range
Dim bottomRow As Long
Dim row As Range
Dim countname As Variant
Dim copyname As Variant
Dim nametoRow As Long
'speed up process
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'set what the variables are
Set wbk = ThisWorkbook
Set ws1 = wbk.Worksheets("Names List")
bottomRow = ws1.Range("A1").End(xlDown).row
'get ird of any excisting values
ws1.Range("C1:D100").ClearContents
'Set the range of the names that you want to copy, and put them into column C
Set cprange = ws1.Range(Range("A1"), Range("A1" & bottomRow))
ws1.Range(Range("C1"), Range("C1" & bottomRow)) = cprange.Value
'then remove all the duplicates
Set rmrange = ws1.Range(Range("C1"), Range("C1" & bottomRow))
rmrange.RemoveDuplicates Columns:=1, Header:=xlNo
'redclare the range as it will be shorter because you got rid of load sof duplicates
Set rmrange = ws1.Range(Range("C1"), Range("C1").End(xlDown))
'loop though each name in the 'unique' list and loop through their names in the original data then add the country to their new location in column D
For Each copyname In rmrange
For Each row In cprange
nametoRow = ws1.Application.WorksheetFunction.Match(copyname, rmrange, False)
countname = row.Offset(0, 1)
If row.Value = copyname Then
If Trim(ws1.Range("D" & nametoRow) & vbNullString) = vbNullString Then
ws1.Range("D" & nametoRow) = countname
Else
ws1.Range("D" & nametoRow) = ws1.Range("D" & nametoRow) & "/ " & countname
End If
End If
Next row
Next copyname
'turn these back on otherwise it messes with your computer/excel
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Here is a more efficient method.
Advanced Filter to remove duplicates from Col A, paste on Col C
Set necessary ranges
Loop through each unique name
Build String
Paste String
Loop 4 - 6 until complete
Assumptions/Actions: You have headers on Col A, B, C, & D. If you have duplicate countries for a person, the country will show up twice on the string.You will need to change "Sheet1" to your sheet name on the 3rd line.
Usually you would need to check if your value is found using the .Find method, but the below logic does not allow for a cell to not be found as it is looping through values determined by filter. It wouldn't make since for a filtered object to not be found in the range it came from.
Option Explicit
Sub CountryList()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim FoundCell As Range, SearchRange As Range, Names As Range, SearchCell As Range
Dim MyString As String, i As Long
Set SearchRange = ws.Range("A2:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
SearchRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("C2"), Unique:=True
ws.Range("C2").Delete Shift:=xlShiftUp
Set Names = ws.Range("C2:C" & ws.Range("C" & ws.Rows.Count).End(xlUp).Row)
For Each SearchCell In Names
Set FoundCell = SearchRange.Find(SearchCell)
For i = 1 To Application.WorksheetFunction.CountIf(SearchRange, SearchCell)
MyString = MyString & FoundCell.Offset(, 1) & "/"
Set FoundCell = SearchRange.FindNext(FoundCell)
Next i
SearchCell.Offset(, 1) = Left(MyString, Len(MyString) - 1)
MyString = ""
Next SearchCell
End Sub

VBA VLookup in Loop

I´m trying to do a VLOOKUP of a column data set at a Sheet called "SyS" in G column. and I'd like to Vlookup relevant data using columns in another sheet called "CONF_mapping", located in the same Workbook. I need to find my data located at the range ("A1:E65000") (It's at column A, but I need to retrieve data from other columns with my vlookup to SyS). I'm not getting good results with my code, and I beg your pardon, it´s my first question in the forum.
Worksheets("SyS").Select
Dim wsThis As Worksheet
Dim aCell As Range
Sheets("CONF_mapping").Columns(2).Copy Destination:=Sheets("SyS").Columns(8)
Set wsThis = Sheets("SyS")
With wsThis
For Each aCell In .Range("A1:E65000")
'.Cells(aCell.Row, 8) = "Not Found"
On Error Resume Next
.Cells(aCell.Row, 8) = Application.WorksheetFunction.VLookup( _
aCell.value, wsThat.Range("G2:G65000"), 2, False)
On Error GoTo 0
Next aCell
End With
Worksheets("SyS").Select
I have find this code but I was not able to make it works for me.
I would appreciate any help.
You have mistake here:
VLookup(aCell.value, wsThat.Range("G2:G65000"), 2, False)
Range "G2:G65000" Have just 1 column G, but you try to get column#2 which does not exists.
UPD:
I guess you need something like this:
Const COLUMN_TO_MATCH_IN_SYS = 8
Const COLUMN_TO_MATCH_IN_CONF = 1
Sub test()
Dim wsSys As Worksheet
Dim wsConf As Worksheet
Set wsSys = Sheets("SyS")
Set wsConf = Sheets("CONF_mapping")
Dim RowSys As Range
Dim RowConf As Range
For Each RowSys In wsSys.UsedRange.Rows
For Each RowConf In wsConf.UsedRange.Rows
If RowSys.Cells(1, COLUMN_TO_MATCH_IN_SYS) = _
RowConf.Cells(1, COLUMN_TO_MATCH_IN_CONF) Then
' Copy row values which is needed
RowSys.Cells(1, 6) = RowConf.Cells(1, 1) ' From column A(conf) to G(sys)
RowSys.Cells(1, 7) = RowConf.Cells(1, 2) ' From column B(conf) to H (sys)
End If
Next aCell
Next
End Sub
With this solution you don't need to search the Range for each cell (just for each row), so it will work 5 times faster.

Maintaining destination data format when copying style in VBA?

I am trying to copy the style from a specific column (formatted as Text starting from its second row) to another column (formatted as Date starting from its second row). Both columns stores values.
I am able to copy-and-paste the style to the destination column:
.Columns("A").Copy '# "A" is the starting column
.Columns(dest_col).PasteSpecial Paste:=xlPasteFormats '# dest_col is the destination column
but this code also formats it as a Text column, while I want to keep its original formatting (i.e. Date starting from the second row).
Is there any option I can use to prevent this behavior?
You may try to take only the values of the specific parameters, which you are interested in (E.g., style, Interior Color, Font Color etc.)
The following works only when the whole column has the same format, as far as I did not to loop through every cell:
Option Explicit
Sub TestMe()
Dim colFrom As Long
Dim colTo As Long
colFrom = 1
colTo = 5
CopyFullFontAndInterior colFrom, colTo
End Sub
Sub CopyFullFontAndInterior(colFrom As Long, colTo As Long, Optional wsN As Long = 1)
Dim copyFrom As Range
Dim copyTo As Range
With Worksheets(1)
Set copyFrom = .Range(.Cells(1, colFrom), .Cells(2 ^ 20, colFrom))
Set copyTo = .Range(.Cells(1, colTo), .Cells(2 ^ 20, colTo))
End With
copyTo.Style = copyFrom.Style
If copyFrom.Interior.Color > 0 Then copyTo.Interior.Color = copyFrom.Interior.Color
If copyFrom.Font.Color > 0 Then copyTo.Font.Color = copyFrom.Font.Color
End Sub
A possible workaround is to save the format of a given cell of the column in a variable and to use it after the .PasteSpecial:
Sub TestMe()
Dim saveOurFormat As String
saveOurFormat = Columns(5).Cells(2).NumberFormat
Columns("A").Copy
Columns(5).PasteSpecial Paste:=xlPasteFormats
Columns(5).NumberFormat = saveOurFormat
Application.CutCopyMode = False
End Sub

Type Mismatch Error after MsgBox

my data is as below .
Updated Question
Sub Solution()
Dim shData As Worksheet
Set shData = Sheets("Sheet1") 'or other reference to data sheet
Dim coll As Collection, r As Range, j As Long
Dim myArr As Variant
Dim shNew As Worksheet
shData.Activate
'get unique values based on Excel features
Range("a1").AutoFilter
Set coll = New Collection
On Error Resume Next
For Each r In Range("A1:A10")
coll.Add r.Value, r.Value
Next r
On Error GoTo 0
'Debug.Print coll.Count
For j = 1 To coll.Count
MsgBox coll(j)
myArr = coll(j)
Next j
Range("a1").AutoFilter
Dim i As Long
For i = 0 To UBound(myArr)
shData.Range("$A$1").AutoFilter Field:=1, Criteria1:=myArr(i), _
Operator:=xlAnd
On Error Resume Next
Sheets(myArr(i)).Range("A1").CurrentRegion.ClearContents
If Err.Number = 0 Then
Range("A1").CurrentRegion.Copy Sheets(myArr(i)).Range("A1")
Else
Set shNew = Sheets.Add(After:=Sheets(Sheets.Count))
shData.Range("A1").CurrentRegion.Copy shNew.Range("A1")
shNew.Name = myArr(i)
Err.Clear
End If
Next i
'removing filter in master sheet
shData.Range("a1").AutoFilter
End Sub
When I run above macro I don't know why it is giving Type Mismatch Error after MsgBox coll(j) , simply I want to store data in Array and I'm passing that data , Here I am using For Each r In Range("A1:A10") Where A10 length is static how can I find last written column?
When you add something to collection the key needs to be a string so use:
coll.Add r.Value, CStr(r.Value)
instead of:
coll.Add r.Value, r.Value
You are still assigning coll(j) to a Variant which is not an array.
You need to:
ReDim myArr(1 to coll.Count)
Before your for loop and then in the loop:
myArr(j) = coll(j)
Before attempting to respond to this question, I would like to write what I believe you are trying to accomplish; when you confirm this is what you are trying to do, I will try to help you get working code to achieve it. This would normally be done with comments, but the threads of comments so far are a bit disjointed, and the code is quite complex...
You have data in a sheet (called "sheet1" - it might be something else though)
The first column contains certain values that might be repeated
You don't know how many columns there might be... you would like to know that though
You attempt to find each unique value in column A (call it the "key value"), and display it (one at a time) in a message box. This looks more like a debug step than actual functionality for the final program.
You then turn on the autofilter on column A; selecting only rows that match a certain value
Using that same value as the name of a sheet, you see if such a sheet exists: if it does, you clear its contents; if it does not, then you create it at the end of the workbook (and give it the name of the key)
You select all rows with the same (key) value in column A on sheet1, and copy them to the sheet whose name is equal to the value in column A that you filtered on
You want to repeat step 5-8 for each of the unique (key) values in column A
When all is done, I believe you have (at least) one more sheet than you had key values in column A (you also have the initial data sheet); however you do not delete any "superfluous" sheets (with other names). Each sheet will have only rows of data corresponding to the current contents of sheet1 (any earlier data was deleted).
During the operation you turn autofiltering on and off; you want to end up with auto filter disabled.
Please confirm that this is indeed what you are attempting to do. If you could give an idea of the format of the values in column A, that would be helpful. I suspect that some things could be done rather more efficiently than you are currently doing them. Finally I do wonder whether the whole purpose of organizing your data in this way might be to organize the data in a specific way, and maybe do further calculations / graphs etc. There are all kinds of functions built in to excel (VBA) to make the job of data extraction easier - it's rare that this kind of data rearranging is necessary to get a particular job done. If you would care to comment on that...
The following code does all the above. Note the use for For Each, and functions / subroutines to take care of certain tasks (unique, createOrClear, and worksheetExists). This makes the top level code much easier to read and understand. Also note that the error trapping is confined to just a small section where we check if a worksheet exists - for me it ran without problems; if any errors occur, just let me know what was in the worksheet since that might affect what happens (for example, if a cell in column A contains a character not allowed in a sheet name, like /\! etc. Also note that your code was deleting "CurrentRegion". Depending on what you are trying to achieve, "UsedRange" might be better...
Option Explicit
Sub Solution()
Dim shData As Worksheet
Dim nameRange As Range
Dim r As Range, c As Range, A1c As Range, s As String
Dim uniqueNames As Variant, v As Variant
Set shData = Sheets("Sheet1") ' sheet with source data
Set A1c = shData.[A1] ' first cell of data range - referred to a lot...
Set nameRange = Range(A1c, A1c.End(xlDown)) ' find all the contiguous cells in the range
' find the unique values: using custom function
' omit second parameter to suppress dialog
uniqueNames = unique(nameRange, True)
Application.ScreenUpdating = False ' no need for flashing screen...
' check if sheet with each name exists, or create it:
createOrClear uniqueNames
' filter on each value in turn, and copy to corresponding sheet:
For Each v In uniqueNames
A1c.AutoFilter Field:=1, Criteria1:=v, _
Operator:=xlAnd
A1c.CurrentRegion.Copy Sheets(v).[A1]
Next v
' turn auto filter off
A1c.AutoFilter
' and screen updating on
Application.ScreenUpdating = True
End Sub
Function unique(r As Range, Optional show)
' return a variant array containing unique values in range
' optionally present dialog with values found
' inspired by http://stackoverflow.com/questions/3017852/vba-get-unique-values-from-array
Dim d As Object
Dim c As Range
Dim s As String
Dim v As Variant
If IsMissing(show) Then show = False
Set d = CreateObject("Scripting.Dictionary")
' dictionary object will create unique keys
' have to make it case-insensitive
' as sheet names and autofilter are case insensitive
For Each c In r
d(LCase("" & c.Value)) = c.Value
Next c
' the Keys() contain unique values:
unique = d.Keys()
' optionally, show results:
If show Then
' for debug, show the list of unique elements:
s = ""
For Each v In d.Keys
s = s & vbNewLine & v
Next v
MsgBox "unique elements: " & s
End If
End Function
Sub createOrClear(names)
Dim n As Variant
Dim s As String
Dim NewSheet As Worksheet
' loop through list: add new sheets, or delete content
For Each n In names
s = "" & n ' convert to string
If worksheetExists(s) Then
Sheets(s).[A1].CurrentRegion.Clear ' UsedRange might be better...?
Else
With ActiveWorkbook.Sheets
Set NewSheet = .Add(after:=Sheets(.Count))
NewSheet.Name = s
End With
End If
Next n
End Sub
Function worksheetExists(wsName)
' adapted from http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html
worksheetExists = False
On Error Resume Next
worksheetExists = (Sheets(wsName).Name <> "")
On Error GoTo 0
End Function

Search for multiple phrase; copy to single sheet across multiple sheets

I am using Microsoft Excel to keep track of tasks. I use a different "sheet" for each job. The structure is with regards to columns and data. I have been trying to create a VBA script that would accomplish the following:
Search sheets 1 - X for a value of "Open" or "Past Due" in a row
Copy all rows with those values into a single sheet (such as a ledger) starting at row 3 (so I can add the headers of the template)
Add a column A with the sheet name so that I know what job it came from.
Run this to my hearts obsessive compulsive behavior pleasure to update with new items
I have been using the following posts to help guide me:
Search a specific word and copy line to another Sheet <- which was helpful but not quite right...
Copying rows to another worksheet based on a search on a grid of tags <-- also helpful, but limited to the activesheet and not looping correctly with my modifications...
The last two evenings have been fun, but I feel like I may be making this harder than necessary.
I was able to create a VBA script (edited from another post here) to sweep through all the worksheets, but it was designed to copy all data in a set of columns. I tested that and it worked. I then merged the code base I was using to identify "Open" or "Past Due" in column C (that worked for only the activesheet) into the code. I marked up my edits to share here. At this point it is not functioning, and I have walked myself dizzy. Any tips on where I fubar-ed the code would be appreciated. My code base I working from is:
Sub SweepSheetsCopyAll()
Application.ScreenUpdating = False
'following variables for worksheet loop
Dim W As Worksheet, r As Single, i As Single
'added code below for finding the fixed values on the sheet
Dim lastLine As Long
Dim findWhat As String
Dim findWhat1 As String
Dim findWhat2 As String
Dim toCopy As Boolean
Dim cell As Range
Dim h As Long 'h replaced i variable from other code
Dim j As Long
'replace original findWhat value with new fixed value
findWhat = "Open"
'findWhat2 = "Past Due"
i = 4
For Each W In ThisWorkbook.Worksheets
If W.Name <> "Summary" Then
lastLine = ActiveSheet.UsedRange.Rows.Count 'Need to figure out way to loop all rows in a sheet to find last line
For r = 4 To lastLine 'formerly was "To W.Cells(Rows.Count, 1).End(xlUp).Row"
'insert below row match search copy function
For Each cell In Range("B1:L1").Offset(r - 1, 0)
If InStr(cell.Text, findWhat) <> 0 Then
toCopy = True
End If
Next
If toCopy = True Then
' original code Rows(r).Copy Destination:=Sheets(2).Rows(j)
Range(W.Cells(r, 1), W.Cells(r, 12)).Copy _
ThisWorkbook.Worksheets("Summary").Cells(i, 1)
j = j + 1
End If
toCopy = False
'Next
'end above row match search function
'below original code that copied everything from whole worksheet
' If W.Cells(r, 1) > 0 Then
' Range(W.Cells(r, 1), W.Cells(r, 12)).Copy _
' ThisWorkbook.Worksheets("Summary").Cells(i, 1)
' i = i + 1
' End If
Next r
End If
Next W
End Sub
The working code base to sweep through all the sheets was:
Sub GetParts()
Application.ScreenUpdating = False
Dim W As Worksheet, r As Single, i As Single
i = 4
For Each W In ThisWorkbook.Worksheets
If W.Name <> "Summary" Then
For r = 4 To W.Cells(Rows.Count, 1).End(xlUp).Row
If W.Cells(r, 1) > 0 Then
Range(W.Cells(r, 1), W.Cells(r, 3)).Copy _
ThisWorkbook.Worksheets("Summary").Cells(i, 1)
i = i + 1
End If
Next r
End If
Next W
End Sub
And the copy the matched data from the Activesheet is as follows:
Sub customcopy()
Application.ScreenUpdating = False
Dim lastLine As Long
Dim findWhat As String
Dim findWhat1 As String
Dim findWhat2 As String
Dim toCopy As Boolean
Dim cell As Range
Dim i As Long
Dim j As Long
'replace original findWhat value with new fixed value
findWhat = "Open"
'findWhat2 = "Past Due"
lastLine = ActiveSheet.UsedRange.Rows.Count 'Need to figure out way to loop through all sheets here
'below code does nice job finding all findWhat and copying over to spreadsheet2
j = 1
For i = 1 To lastLine
For Each cell In Range("B1:L1").Offset(i - 1, 0)
If InStr(cell.Text, findWhat) <> 0 Then
toCopy = True
End If
Next
If toCopy = True Then
Rows(i).Copy Destination:=Sheets(2).Rows(j)
j = j + 1
End If
toCopy = False
Next
i = MsgBox(((j - 1) & " row(s) were copied!"), vbOKOnly, "Result")
Application.ScreenUpdating = True
End Sub
You should look into this Vba macro to copy row from table if value in table meets condition
In your case, you would need to create a loop, using this advanced filter to copy the data to your target range or array.
If you need further advice, please post your code, and where you are stuck with it.