Filtering data VBA with 3 criteria

cortexnotion

New Member
Joined
Jan 22, 2020
Messages
36
Office Version
2013
Platform
Windows
Good Morning,

I stumbled across this forum through some research and I was hoping you could help me with some VBA code.

I have a data set A4:P7000 (row 3 is Headers) which I have set up as an array. I need to remove the following things from the data before copying the matching rows to the new workbook in Sheet1 from cell A2. The curveball is I need to copy the row in reverse order leading with Column P to A. My string criteria is:

- Remove any values from Column F equal 0
- Remove any values from Column A and Column B that match the names in the NamesArray anywhere in the string (wildcard?) and case not to be sensitive

I've had a go setting my arrays and starting my code but not sure on how to compare the range array with the name array and factor in my wildcard need. I'm also not sure how to copy the data to the new workbook.

VBA Code:
Option Compare Text

Sub myarray()

Dim sh1 As Worksheet, wb2 as Workbook, sh2 as Worksheet
Dim dataarray As Variant, namesarray As Variant,
Dim i As Long

Set sh1 = Worksheets("RawData")
Set wb2 = Workbooks.Open("C:\Userx\tempwork\new.xlsm")

dataarray = Range("A4:P7000").Value
namesarray = Array("JOHN","CLAIRE","PETER","MICHELLE","PAUL","CHRIS")

For i = LBound(TheArray) To UBound(TheArray)
If RangeArray(i, 6) > 0 And _
   RangeArray(i, 10) Like ??? 'How to perform comparison with namesarray?


Many thanks

Chris.
 

FatBoyClam

Board Regular
Joined
Jan 8, 2020
Messages
175
Office Version
365
Platform
Windows
Firstly, you appear to be inconsistent with your array names.

You declare and fill "dataarray" and "namesarray", but then start looping through "TheArray" and testing the values in "RangeArray".

Break your tests into separate If statements and then put another loop to check the values against namesarray;

VBA Code:
Option Compare Text

Sub myarray()

Dim sh1 As Worksheet, wb2 As Workbook, sh2 As Worksheet
Dim dataarray As Variant, namesarray As Variant
Dim i As Long, x As Integer

Set sh1 = Worksheets("RawData")
Set wb2 = Workbooks.Open("C:\Userx\tempwork\new.xlsm")

dataarray = Range("A4:P7000").Value
namesarray = Array("JOHN", "CLAIRE", "PETER", "MICHELLE", "PAUL", "CHRIS")

For i = LBound(dataarray) To UBound(dataarray)
    If dataarray(i, 6) > 0 Then
        dataarray(i, 6) = ""
    End If
    
    For x = LBound(namesarray) To UBound(namesarray)
        If dataarray(i, 1) Like "*" & namesarray(x) & "*" Then
            dataarray(i, 1) = ""
        End If
        If dataarray(i, 2) Like "*" & namesarray(x) & "*" Then
            dataarray(i, 2) = ""
        End If
    Next x
Next i
 

cortexnotion

New Member
Joined
Jan 22, 2020
Messages
36
Office Version
2013
Platform
Windows
Thanks @FatBoyClam for your kind help.

As the namesarray criteria is to NOT find the array words would I do it like this?

VBA Code:
For x = LBound(namesarray) To UBound(namesarray)
        If Not dataarray(i, 1) Like "*" & namesarray(x) & "*" Then
            dataarray(i, 1) = ""
        End If
        If Not dataarray(i, 2) Like "*" & namesarray(x) & "*" Then
            dataarray(i, 2) = ""
        End If
Would you also be able to help me with copying the matching rows to the 2nd workbook in Sheet1 from cell A2. I need to copy the rows in reverse order leading with Column P to A.

Many thanks again,

Chris.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,632
Office Version
2007
Platform
Windows
Hi cortexnotion and welcome to MrExcel.

As the namesarray criteria is to NOT find the array words would I do it like this?

If Not dataarray(i, 1) Like "*" & namesarray(x) & "*" Then
If you have "Claire" in the cell, but you check "John," the result is that John can't find it, then delete the contents of the cell.

It could be as follows. I also added the part to put the data in book 2 on sheet1. Reversing the columns from P to A

VBA Code:
Option Explicit

Option Compare Text

Sub myarray()

  Dim sh1 As Worksheet, wb2 As Workbook, sh2 As Worksheet
  Dim dataarray As Variant, namesarray As Variant
  Dim i As Long, x As Integer, j As Long, e1 As Boolean, e2 As Boolean
  
  Set sh1 = Worksheets("RawData")
  Set wb2 = Workbooks.Open("C:\Userx\tempwork\new.xlsm")
  
  dataarray = Range("A4:P10").Value
  namesarray = Array("JOHN", "CLAIRE", "PETER", "MICHELLE", "PAUL", "CHRIS")
  
  For i = LBound(dataarray) To UBound(dataarray)
    If dataarray(i, 6) = 0 Then dataarray(i, 6) = ""
    e1 = False
    e2 = False
    For x = LBound(namesarray) To UBound(namesarray)
      If dataarray(i, 1) Like "*" & namesarray(x) & "*" Then
        e1 = True
      End If
      If dataarray(i, 2) Like "*" & namesarray(x) & "*" Then
        e2 = True
      End If
    Next x
    If e1 = False Then dataarray(i, 1) = ""
    If e2 = False Then dataarray(i, 2) = ""
  Next i
  
  j = 1
  For i = UBound(dataarray, 2) To 1 Step -1
    wb2.Sheets("Sheet1").Cells(2, j).Resize(UBound(dataarray, 1), 1).Value = Application.Index(dataarray, 0, i)
    j = j + 1
  Next
End Sub
 

cortexnotion

New Member
Joined
Jan 22, 2020
Messages
36
Office Version
2013
Platform
Windows
Hi @DanteAmor, thank you for the welcome.

I'm very sorry I think I've been clumsy with my words! When I said clear, i meant delete the row before copying the matches.

I don't want to clear the contents of any cells, just copy the matching rows if:

- Column 6 is greater than 0
- Column A and Column B do not contain any of wildcards of words in the namesarray.

Thanks again, Chris!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,632
Office Version
2007
Platform
Windows
Then to understand well.
In the following example, which rows should be copied.
And you could also put how you want to paste the rows and where you want to paste them, is it a new sheet?

Book1
ABP
3ABP
4A4B40
5JOHNB50
6A6PETER0
7CLAIREMICHELLE0
8A8B81
9A9MICHELLE1
10PAULCHRIS1
11CHRISB111
RawData
 

cortexnotion

New Member
Joined
Jan 22, 2020
Messages
36
Office Version
2013
Platform
Windows
Yes, the location is correct.

I'm sure this is what you have in mind, but I want to copy the entire rows in reverse. A-P becomes P-A. Cheers
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,632
Office Version
2007
Platform
Windows
Try this:

VBA Code:
Option Explicit

Option Compare Text

Sub myarray()
  Dim wb2 As Workbook, a As Variant, b As Variant, namesarray As Variant
  Dim i As Long, x As Integer, j As Long, k As Long, n As Long, e1 As Boolean
  
  Set wb2 = Workbooks.Open("C:\Userx\tempwork\new.xlsm")
  
  a = Range("A4:P7000").Value
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  namesarray = Array("JOHN", "CLAIRE", "PETER", "MICHELLE", "PAUL", "CHRIS")
  k = 1
  
  For i = 1 To UBound(a)
    e1 = True
    If a(i, 6) = 0 Then
      e1 = False
    Else
      For x = LBound(namesarray) To UBound(namesarray)
        If a(i, 1) & a(i, 2) Like "*" & namesarray(x) & "*" Then e1 = False
      Next x
    End If
    If e1 = True Then
      n = 1
      For j = UBound(a, 2) To 1 Step -1
        b(k, n) = a(i, j)
        n = n + 1
      Next j
      k = k + 1
    End If
  Next i
  
  wb2.Sheets("Sheet1").Range("A2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub
 

Forum statistics

Threads
1,085,153
Messages
5,382,010
Members
401,766
Latest member
uyedaj

Some videos you may like

This Week's Hot Topics

Top