vba help - replace filter via array

[Mallesh23]

Hi Team,

I want to filter Score greater than 40 Fifty's and greater than 25 Century.

Filter on Column C and D Data,
Expected Output are in Column Range("H2:j7") , how to use array to meet condition.


Below is attempted code only able to copy First Column

Sub FilterData()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
 
  With Sheets("Sheet1")
    a = .Range("A2:D7").Value
  End With
  ReDim b(1 To UBound(a), 1 To 2)
  For i = 1 To UBound(a)
    If a(i, 3) > 40 And a(i, 4) > 25 Then  'Greater than 40 Fifty and Greater than 25 Century
      k = k + 1
      b(k, 1) = a(i, 1)' how to add remaning cells here
    End If
  Next i
  If k > 0 Then Sheets("Sheet1").Range("h2").Resize(k).Value = b
End Sub

Below is a sample data with expected output.

Book6
	A	B	C	D	E	F	G	H	I	J
1	Player Name	Country	Fifty	Century		Expected Output	"=====>"	Name	Country	Century
2	Sachin	India	100	50				Sachin	India	50
3	Dhoni	India	90	28				Dhoni	India	28
4	Ponting	Australia	80	40				Ponting	Australia	40
5	Peterson	England	100	25				Gilchrist	Australia	80
6	Gayle	West Indies	40	32
7	Gilchrist	Australia	65	80
Sheet1

Cell Formulas
Range	Formula
I2:I5	I2	=VLOOKUP(H2,A1:$D$7,2,0)
J2:J5	J2	=VLOOKUP(H2,$A$1:$D$7,4,0)

Named Ranges
Name	Refers To	Cells
_FilterDatabase	=Sheet1!$A$1:$D$7	I2:J2, J3:J5

Thanks
mg

 

[Fluff]

Do you just want the Century column, or do you want the Fifty column as well?

 

[Mallesh23]

Hi Fluff,

if you give both solution for 3 columns and 4 Columns code, I will be ok for it.

I am learning Array with small examples. Thanks




Thanks
mg

 

[Fluff]

This will give you all 4 columns

Sub FilterData()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long, j As Long
 
  With Sheets("Sheet1")
    a = .Range("A2:D7").Value
  End With
  ReDim b(1 To UBound(a), 1 To UBound(a, 2))
  For i = 1 To UBound(a)
    If a(i, 3) > 40 And a(i, 4) > 25 Then  'Greater than 40 Fifty and Greater than 25 Century
      k = k + 1
      For j = 1 To UBound(a, 2)
         b(k, j) = a(i, j) ' how to add remaning cells here
      Next j
    End If
  Next i
  If k > 0 Then Sheets("Sheet1").Range("h2").Resize(k, UBound(b, 2)).Value = b
End Sub

 

[Mallesh23]

Hi Fluff,

Very nice piece of code, one more help , If I want 3 Columns.
Say Name , Country and Centry , What will be code for this situation.




Thanks
mg

 

[Fluff]

try

Sub FilterData()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long, j As Long
 
  With Sheets("Sheet1")
    a = .Range("A2:D7").Value
  End With
  ReDim b(1 To UBound(a), 1 To UBound(a, 2) - 1)
  For i = 1 To UBound(a)
    If a(i, 3) > 40 And a(i, 4) > 25 Then  'Greater than 40 Fifty and Greater than 25 Century
      k = k + 1
      For j = 1 To UBound(a, 2)
         If j < 3 Then
            b(k, j) = a(i, j) ' how to add remaning cells here
         ElseIf j = 4 Then
            b(k, j - 1) = a(i, j)
         End If
      Next j
    End If
  Next i
  If k > 0 Then Sheets("Sheet1").Range("h2").Resize(k, UBound(b, 2)).Value = b
End Sub

 

[Mallesh23]

Hi Fluff,

Perfect ! it worked , getting output as expected,
Thanks for your help. ?




Thanks
mg

 

[Fluff]

You're welcome & thanks for the feedback.