Filtering data VBA with 3 criteria

[cortexnotion]

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.

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]

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;

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]

Thanks @FatBoyClam for your kind help.

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

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]

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

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]

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]

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
	A	B														P
3	A	B														P
4	A4	B4														0
5	JOHN	B5														0
6	A6	PETER														0
7	CLAIRE	MICHELLE														0
8	A8	B8														1
9	A9	MICHELLE														1
10	PAUL	CHRIS														1
11	CHRIS	B11														1
RawData

 

[cortexnotion]

Hi @DanteAmor, thank you. We would copy Row 8.

 

[DanteAmor]

Hi @DanteAmor, thank you. We would copy Row 8.

Do you want the result in wb2 ("C:\Userx\tempwork\new.xlsm") on sheet1?

In this way:

Book1
	A														O	P
1
2	1														B8	A8
Sheet1

 

[cortexnotion]

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]

Try this:

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