Extracting data from an array into a new array

[pezz18]

Hi,

I am attempting to write a macro which will loop through a sheet of data and then extract specific lines of data if it matches a certain condition - the extracted data should also be removed from the initial sheet of data.

My initial thoughts are to create 3 arrays:

Array 1: load all the existing data in the sheet, then, loop through the array and use an If Else to test if the line of data matches a certain condition. If there is not a match, add it to Array 2, if there is a match, add it to Array 3.

Finally, once the loop is complete, Array 1 can be deleted and then the initial data in the worksheet can also deleted. Then, all the data from Array 2 can be pasted back into the worksheet. All the contents of Array 3 can then be pasted into a new worksheet.

So far i have the following code:

'set up variables
'Dim foundCount As Integer
Dim searchName As String    'named used for criteria 1 on the IF statement
Dim searchDate As Date        'date used for criteria 2 on the IF statement
Dim data As Variant        'Array 1 to store all current data in the record
Dim noMatch As Variant        'Array 2 to store all data which does not match 
Dim match As Variant        'Array 3 to store all data which is a match
Dim lastRow As Integer        'used to track last line of data in the record
Dim found As Integer        'used to keep a count of the number of matching criterias
Dim x As Integer        'used to keep track of Array 1s position during the loop

searchName = ActiveSheet.Range("C4").Value    'the value selected by the user - criteria 1
searchDate = ActiveSheet.Range("F4").Value    'the value selected by the user - criteria 2
found = 0                    'set the found to 0
x = 0

'Work out the last row of data:
lastRow = Sheets("Record").Range("B" & Rows.Count).End(xlUp).Row

'load all of this data into Array 1
data = Sheets("Record").Range("B6:L" & lastRow).Value

For i = LBound(data, 1) To UBound(data, 1)    'loop through the array    

    'check to see if the name & date criteria is a match
    If data(i, 1) = searchName And data(i, 3) = searchDate Then   
        
    'if a match then 
        ReDim Preserve result(x, 11)  'resave the match array keeping all current entries
        match(x, 0) = data(i, 1)      'Add the matched data to the new array 
        match(x, 1) = data(i, 2)      'x = position of the match array
        match(x, 2) = data(i, 3)      'i = the position of the data array
        match(x, 3) = data(i, 4)
        match(x, 4) = data(i, 5)
        match(x, 5) = data(i, 6)
        match(x, 6) = data(i, 7)
        match(x, 7) = data(i, 8)
        match(x, 8) = data(i, 9)
        match(x, 9) = data(i, 10)
        match(x, 10) = data(i, 11)
        found = found + 1        'increment by 1 so we know how many lines we find
        x = x + 1            'increment by 1 so we now the next array position
    End If
Next i

'paste the contents of the match array into a new sheet
Sheets("Alterations").Range("B8:L" & found).Value = match

At the moment, my code doesn't work and i am getting a Type Mismatch error. When I debug, i can see that the matching data has been found correctly, i am just struggling to then add it to the new array.

Also, at present - until i can get the initial bit working - my IF statement is only looking at the matching criteria

Canyone help with what i am trying to achieve?

I understand that you can't delete an item from an array, hence why i am using 3 arrays
I have heard of Dictionary and Collections which may be a better solution, however, I've googled these and cant work out how to use a multi-dimensional Dictionary / Collection - unsure if this is even possible

Any help would be appreciated

Thanks

 

[Fennek]

Hi,

for a 1-dim Array there is the funktion
Array_New = Filter(Array_old, "Criteria")

The meaning is similar to "contain criteria"

To apply this to a column, start creating a 1d-array:
Ar = application.transpose(range("A1:A30"))
add the row number:

for i = 1 to ubound(Ar)
Ar(i) = i & ", " & Ar(i)
next i

apply the filter:
Ar_new = filter(Ar, "Criteria")

Then delete all rows with the number of Ar_new

reards