HI all, I am really struggling to get the worksheetfunction.filter to work.
I have a formula in in a worksheet that filters (because i want to return multiple values) and it works in excel. if i use worksheet.formula in the vba it also works. however I
want to just return the values only, not as a spill. the formula for this is
however when I can get it working the worksheetfunction. i have tried all sorts, the last attempt i cant even get an array to populate. please can you offer some advice? or even a code example?
i really do appreciate your help.
below is the code.
i can post the data iff needed ( i have also tried xlookup to return all the values, but I cant get it to return anything other than a single entry)
I have a formula in in a worksheet that filters (because i want to return multiple values) and it works in excel. if i use worksheet.formula in the vba it also works. however I
want to just return the values only, not as a spill. the formula for this is
however when I can get it working the worksheetfunction. i have tried all sorts, the last attempt i cant even get an array to populate. please can you offer some advice? or even a code example?
i really do appreciate your help.
below is the code.
i can post the data iff needed ( i have also tried xlookup to return all the values, but I cant get it to return anything other than a single entry)
VBA Code:
Sub ListServicetostaff()
'Copies a list of all services from Home Sheet,.
'Set Variables
Dim StaffWs As Worksheet, HomesWs As Worksheet
Dim HomesNamerng As Range, Staffnamerng As Range, StaffServnamerng As Range, Servarrrng As Range, Namearrrng As Range
Dim Homeslr As Long, stafflr As Long, x As Long, prplr As Long
Dim Namearr() As Variant, Servarr() As Variant, FilterArr As Variant, Filtered1() As Variant
'Set Worksheet name Variables
Set StaffWs = ThisWorkbook.Worksheets("Staff Details")
Set HomesWs = ThisWorkbook.Worksheets("Homes")
'Find Last Row of worksheets and Declare Variables
stafflr = StaffWs.Range("A" & Rows.Count).End(xlUp).row
Homeslr = HomesWs.Range("A" & Rows.Count).End(xlUp).row
'Set Named Ranges
Set Staffnamerng = StaffWs.Range("E2:E" & stafflr)
Set HomesNamerng = HomesWs.Range("A2:B" & Homeslr)
' Create Service to Staff sheet in this workbook with loop and delete sheet _
sheet if it already exists prior to creating.
' For Each Worksheet In ThisWorkbook.Worksheets
' If Worksheet.Name = "Service To Staff" Then
'' Disable Alert
' Application.DisplayAlerts = False
' Worksheet.Delete
'' Enable Alert
' Application.DisplayAlerts = True
' End If
' Next Worksheet
' ThisWorkbook.Worksheets.Add(After:=Sheets("License Calculator")).Name _
' = "Service To Staff"
'Declare sheet name as variable and set
Dim ServiceToStaffws As Worksheet
Set ServiceToStaffws = ThisWorkbook.Worksheets("Service to Staff")
'Find last row of sheet
ServiceToStafflr = ServiceToStaffws.Range("A" & Rows.Count).End(xlUp).row
'Copy Service names from Homes Sheet and sort by Provider
HomesNamerng.Copy Destination:=ServiceToStaffws.Range("A2")
Range("A:B").Sort key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes
'Call Sub() that will Prep a sheet so that we can match each service _
to every staff that has access to access care data for that service
' Call PrepStaffForServiceMatch
Dim PrepNameRng As Range, PrepServRng As Range
'Create additional variables and array for filter
Dim Prpedws As Worksheet
Set Prpedws = ThisWorkbook.Worksheets("PrepedStaffToService")
prplr = Prpedws.Range("A" & Rows.Count).End(xlUp).row
Set PrepNameRng = Prpedws.Range("A1:A" & prplr)
Set PrepServRng = Prpedws.Range("B1:B" & prplr)
Set Namearrrng = Prpedws.Range("A1:A" & prplr)
Set Servarrrng = ServiceToStaffws.Range("A1:a" & prplr)
FilterArr = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(PrepNameRng))
'Servarr = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Servarrrng))
'Loop to Match Staff to Service
Application.ScreenUpdating = False
On Error Resume Next
For x = 2 To Homeslr
Filtered1 = Application.WorksheetFunction.filter(FilterArr, Prpedws.Range("A" & x).Value)
Next x
'' 'Loop to Match Staff to Service
' For x = 2 To Homeslr
' ServiceToStaffws.Range("C" & x).Formula2R1C1 = _
' "=TRANSPOSE(FILTER(PrepedStaffToService!C[-2],PrepedStaffToService!C[-1]='Service To Staff'!RC[-2]))"
' Next x
' 'Copy Formulas and paste there values
' ServiceToStaffws.UsedRange.Copy
' ServiceToStaffws.Range("A1").PasteSpecial Paste:=xlPasteValues
'Write Headers including dynamic Header for Staff Name
ServiceToStaffws.Range("A1") = "Service Name"
ServiceToStaffws.Range("B1") = "Provider Name"
'Clean up sheets used for functions
' Application.DisplayAlerts = False
' ThisWorkbook.Worksheets("PrepedStaffToService").Delete
' Application.DisplayAlerts = True
End Sub
Last edited by a moderator: