VBA Filter from another Tab based on cell value

[garypea123]

Good Morning All,

I am looking for a VBA which will look at the result from D3 (Table Tab) and then filter / copy the corresponding name from E2 onwards (Data Tab) and copy all the applicable data (A:L) under this name and paste into C10 (Table Tab)

For info if the word All is in the managers tab it should copy all data.

Thanks
Gary

 

[vcoolio]

Hello Gary,

See if this heads you in the right direction:-

Option Explicit
Sub Test()

        Dim wsTT As Worksheet: Set wsTT = Sheets("Table Tab")
        Dim wsDT As Worksheet: Set wsDT = Sheets("Data Tab")
        Dim NmSearch As String: NmSearch = wsTT.[D3].Value

Application.ScreenUpdating = False
        
        wsTT.[C10].CurrentRegion.Clear
        
        With wsDT.Range("E2", wsDT.Range("E" & wsDT.Rows.Count).End(xlUp))
                .AutoFilter 1, NmSearch
                .Offset(1, -4).Resize(, 12).Copy wsTT.[C10]
                .AutoFilter
        End With

Application.ScreenUpdating = True

End Sub

I'm not sure if you are supposed have headings in the Table Tab starting in C9 or if you just want the relevant rows of data to just start in C10 and then clear the data when the code is next run (which is what the code above does).

I hope that this helps.

Cheerio,
vcoolio.

 

[Marc L]

Hi, a VBA demonstration for starters :​

Sub Demo1()
          Const S = "Table"
         Sheets(S).[C10].CurrentRegion.Clear
    With Sheets("Data")
        .[Z3].Formula = "=E3=""" & Sheets(S).[D3].Text & """"
        .[A1].CurrentRegion.Rows("2:" & .[A1].CurrentRegion.Rows.Count).AdvancedFilter 2, .[Z2:Z3], Sheets(S).[C10]
        .[Z3].Clear
    End With
End Sub

 

[Fluff]

As you have xl365, you could also use a formula

=FILTER(Sheet1!A3:L6,IF(D3="All",ROW(Sheet1!E3:E6)^0,Sheet1!E3:E6=D3))

 

[Marc L]

My demonstration revamped if cell D3 contains "all" :​

Sub Demo1r()
   Const S = "Table"
     Dim T$
         T = Sheets(S).[D3].Text:  If UCase(T) = "ALL" Then T = "*"
         Sheets(S).[C10].CurrentRegion.Clear
    With Sheets("Data")
        .[Z2:Z3].Value2 = Evaluate("{""" & .[E2].Text & """;""" & T & """}")
        .[A1].CurrentRegion.Rows("2:" & .[A1].CurrentRegion.Rows.Count).AdvancedFilter 2, .[Z2:Z3], Sheets(S).[C10]
        .[Z2:Z3].Clear
    End With
End Sub

 

[vcoolio]

Hello Gary,

Here's an update to allow for the criteria "All":

Option Explicit
Sub Test()

        Dim wsTT As Worksheet: Set wsTT = Sheets("Table Tab")
        Dim wsDT As Worksheet: Set wsDT = Sheets("Data Tab")
        Dim NmSearch As String: NmSearch = wsTT.[D3].Value

Application.ScreenUpdating = False
        
        wsTT.[C10].CurrentRegion.Clear
        
        If NmSearch = "All" Then
                wsDT.Range("E3", wsDT.Range("L" & wsDT.Rows.Count).End(xlUp)).Copy wsTT.[C10]
                Else
                With wsDT.Range("E2", wsDT.Range("E" & wsDT.Rows.Count).End(xlUp))
                        .AutoFilter 1, NmSearch
                        .Offset(1, -4).Resize(, 12).Copy wsTT.[C10]
                        .AutoFilter
                End With
        End If
        
Application.ScreenUpdating = True

End Sub

Cheerio,
vcoolio.

 

[garypea123]

Hello Gary,

Here's an update to allow for the criteria "All":

Option Explicit
Sub Test()

        Dim wsTT As Worksheet: Set wsTT = Sheets("Table Tab")
        Dim wsDT As Worksheet: Set wsDT = Sheets("Data Tab")
        Dim NmSearch As String: NmSearch = wsTT.[D3].Value

Application.ScreenUpdating = False
       
        wsTT.[C10].CurrentRegion.Clear
       
        If NmSearch = "All" Then
                wsDT.Range("E3", wsDT.Range("L" & wsDT.Rows.Count).End(xlUp)).Copy wsTT.[C10]
                Else
                With wsDT.Range("E2", wsDT.Range("E" & wsDT.Rows.Count).End(xlUp))
                        .AutoFilter 1, NmSearch
                        .Offset(1, -4).Resize(, 12).Copy wsTT.[C10]
                        .AutoFilter
                End With
        End If
       
Application.ScreenUpdating = True

End Sub

Cheerio,
vcoolio.

This appears to work quite well, but why does it miss rows A:D when using the all function?

 

[garypea123]

As you have xl365, you could also use a formula

=FILTER(Sheet1!A3:L6,IF(D3="All",ROW(Sheet1!E3:E6)^0,Sheet1!E3:E6=D3))

I like this and did not realise the new version could do this. My only concern is if others are using an old version this would cause an issue.

 

[Fluff]

Yes, that only works with 365 or online versions.

 

[vcoolio]

This appears to work quite well, but why does it miss rows A:D when using the all function?

Hello Gary,

I've just seen my typo.

In this line:-

wsDT.Range("E3", wsDT.Range("L" & wsDT.Rows.Count).End(xlUp)).Copy wsTT.[C10]

change the E3 to A3.

Cheerio,
vcoolio.