VBA code to apply autofilter to table already filtered by date by user via treeview dropdown not working

[KathyVBA]

Hi, I am trying to automate some Excel tasks that are very repetitive and I'm having trouble with some VBA code for autofiltering a table after the user has selected dates from a filter dropdown tree. Originally, the file holding the data was the file that included the macros, and the code worked in the way I expected. Unfortunately, I learnt that the Microsoft Form that captures the data on an ongoing basis cannot be saved in .xlsm format. Therefore, I set up a Macro template sheet that my users open and wrote code to import the data needed from the downloaded Microsoft Form .xlsx file. This data file looks like the Client Data file I have uploaded. So, the code I wrote to import the client data to the sheet that holds the macros works, and that code is as follows (please feel free to suggest changes as I am a total newbie at VBA and have put this together via the macro recorder and Googling!):

Sub Get_Data_From_Downloaded_File()
'
' Get Data From Downloaded File Macro
' Copy and paste the entire spreadsheet of client data from the downloaded Client Daily Wellbeing Check .xlsx sheet. Save the sheet under a new name as an .xlsm sheet.
'
'
Dim Cell As Range
Dim vSourceFile As Variant      'File to process
Dim sSourceFileName As String   'File name of source worksheet (downloaded from the Microsoft Form)
Dim sFileSaveName As String     'File name of workbook with imported data
Dim wsSource As Worksheet
Dim wbSource As Excel.Workbook
Dim wsTarget As Worksheet
Dim wbTarget As Excel.Workbook
Dim Ws As Worksheet
  
    'disable screen updating
    Application.ScreenUpdating = False
   
    'set up the target workbook
    Set wbTarget = Application.ActiveWorkbook
  
    'select the Excel source file in the folder
    vSourceFile = Application.GetOpenFilename(FileFilter:="Excel Files (Client Daily Wellness*.xlsx),*.xlsx", Title:="Choose file", MultiSelect:=False)
   
    If vSourceFile = False Then
        'User pressed Cancel
        MsgBox "Please select a file"
        Exit Sub
    End If
      
    'open the source file and set the source worksheet
    Set wbSource = Workbooks.Open(vSourceFile)
    Set wsSource = wbSource.Sheets(1) 'Sheet 1 is the source worksheet
    sSourceFileName = wbSource.Name
    MsgBox ("Source File Name is " & sSourceFileName)
       
    'set up the target worksheet
    wbTarget.Activate
    Set wsTarget = wbTarget.Sheets("Sheet1")
  
    'import the data
    With wbTarget
        wsSource.UsedRange.Copy wbTarget.Sheets("Sheet1").Range("A1")
        wbTarget.Sheets("Sheet1").Columns.AutoFit
    End With
    
    'close the source workbook
    wbSource.Close SaveChanges:=False
    
    With wbTarget
        For Each Ws In Sheets
        Ws.Name = "Client Wellbeing Check Data"
        Next Ws
    End With
     
    'display source filename in Cell N2
    With wbTarget
        Sheets("Client Wellbeing Check Data").Range("N2").Select
        Selection.Value = sSourceFileName
    End With
   
    'save the target workbook with a new file name in .xlsm format
    Application.ActiveWorkbook.SaveAs Filename:=(sSourceFileName & " " & "WITH MACROS"), FileFormat:=52
    Application.ScreenUpdating = True
       
    'Clean Cell("N2") of .xls* characters
    Range("N2").Select
    For Each Cell In Selection.SpecialCells(xlCellTypeConstants, xlTextValues).Cells
        With Cell
            .Value = Application.WorksheetFunction.Substitute(.Value, ".xlsx", " ")
        End With
    Next Cell
    sFileSaveName = ActiveSheet.Range("N2").Value

    'save the imported data workbook again in .xlsm format without the *.xls* characters - I do this twice because it doesn't save properly in .xlsm format the first time, maybe because I am working in Excel 2013 via a Citrix Workspace.
    Application.ActiveWorkbook.SaveAs Filename:=(sFileSaveName & "WITH MACROS"), FileFormat:=52
   
    'Select Cell("A1")
    Range("A1").Select
  
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
   Set wbTarget = Nothing
   Set vSourceFile = Nothing
   Set Ws = Nothing
End Sub

At this point, the user (HM, BC or BM) is supposed to select the dates they want to get data for from the dropdown tree in the "Start time" column, and then run a macro to return individual Excel files for only their clients who were checked on the dates in question. For example if BC selected 10/29/20, and ran the macro to filter for their clients, the macro would return an Excel file for Kimberly D and one for Helen P, but not for Dorothy D or Brendan B. This second task was working before I had to write the code to import the data from the downloaded Microsoft Form file. Unfortunately, now it doesn't work - instead no matter which date(s) are selected, an Excel file is produced for ALL of the clients that each Team Leader has. I am flummoxed, I don't know enough about what I am doing to understand what I have missed or done wrong. The code that I have for this second task is below, and I'd really appreciate some help!

Option Explicit

Sub AutoFilter_Each_Name_HM()
'
' AutoFilter Each Name HM Macro
' Copy and paste HM's individual client data from the downloaded Client Daily Wellbeing Check .xlsx sheet. Paste and format each client's data before saving it under the client's name as an .xlsx sheet.
'
'
    Dim x As Range
    Dim Cell As Range
    Dim Ws As Worksheet
    Dim rnDatesToFilterBy As Range      'The dates to filter the table by
    Dim rnNameList As Range
    Dim rnNameList1 As Range
    Dim rng As Range
    Dim lo As ListObject
    Dim iCol As Long
    Dim last As Long
    Dim newlast As Long
    Dim newlast1 As Long
    Dim sht As String
    Dim NameList As String
    Dim newsht As String
    Dim FName As String
    Dim FPath As String
    Dim sFileSaveName As String         'File name of imported data workbook including macros
    Dim sBadFileFormatPath As String    'Directory path of any file saved with a bad saved file format (in prep for deleting)
    Dim objFSO As Object                'File System Object code to delete bad file format file
    Dim objFolder As Object
    Dim objFile As Object
    Dim IndClientDataBook As Excel.Workbook
    Dim DataBook As Excel.Workbook
    Dim vInputDateRange As Variant
    Dim WellnessCheckDateRange As String
       
    'Disable screen updating
    Application.ScreenUpdating = False
   
    'Workbook where VBA code resides
    Set DataBook = ActiveWorkbook

    'Specify sheet name in which the data is stored
    ActiveSheet.Name = "Client Wellbeing Check Data"
    sht = "Client Wellbeing Check Data"
   
    'Set reference to the first Table on the sheet
    Set lo = Sheets(sht).ListObjects("Table1")
   
    'Set filter range
    'iCol = lo.ListColumns("Start time").Index
   
    'Specify date info to add to filename
    vInputDateRange = Application.InputBox(Prompt:="Use the format dd-dd-mm-yyyy", Title:="Enter date range for Client Daily Wellness Checks", Type:=2, Default:="dd-dd-mm-202y")
    If vInputDateRange = False Then
    End If

    'Worksheet to copy Client Name list to
    DataBook.Sheets.Add(After:=Sheets(sht)).Name = "NameList"
    NameList = "NameList"

    'Activate Client Wellbeing Check Data sheet again
    Worksheets(sht).Activate
       
    ''Turn on AutoFilter by date - An attempt to try and get the code working - no joy
    'ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=2, Operator:=xlFilterValues, Criteria2:="<>0"

    'Change filter column in the following code
    last = DataBook.Sheets(sht).Cells(Rows.Count, "H").End(xlUp).Row
   
    'Copy HM's unique names from Column H on Client Wellbeing Check Data sheet to Column H on NameList sheet
    DataBook.Sheets(sht).Range("H1:H" & last).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets(sht).Range("H1:H" & last), CopyToRange:=Sheets(NameList).Range("H1"), Unique:=True
    Worksheets(NameList).Activate
   
    'Determine new last row of data
    newlast1 = DataBook.Sheets(NameList).Cells(Rows.Count, "H").End(xlUp).Row
   
    'Define rnNameList1
    With DataBook.Sheets(NameList)
        Set rnNameList1 = .Range("H2:H" & newlast1).SpecialCells(xlCellTypeBlanks)
    End With
   
    'Delete blank cell(s) in pasted data and shift upward
    rnNameList1.Cells.Delete Shift:=xlShiftUp
       
    'Determine new last row of data without blanks
    newlast = DataBook.Sheets(NameList).Cells(Rows.Count, "H").End(xlUp).Row
   
    'Define rnNameList
    With DataBook.Sheets(NameList)
        Set rnNameList = .Range("H2:H" & newlast)
    End With
       
    'Sort listing alphabetically
    DataBook.Sheets(NameList).Range("H2:H" & newlast).Select
    For Each Cell In Selection
        Selection.Sort Key1:=Range("H2:H" & newlast), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    Next Cell
   
    With DataBook.Sheets(sht)
        Set rng = .Range("A1:L" & last)
    End With

    For Each x In DataBook.Sheets(NameList).Range("H2:H" & newlast)
        With rng
            .AutoFilter
            .AutoFilter Field:=8, Criteria1:=x.Value
            .SpecialCells(xlCellTypeVisible).Copy
   
        'New Workbook
        Set IndClientDataBook = Workbooks.Add(xlWBATWorksheet)
            IndClientDataBook.Activate
            ActiveSheet.Paste
            Selection.Columns.AutoFit
      
        'Select cell for name for ActiveSheet
        IndClientDataBook.ActiveSheet.Range("H2").Select
   
        'Clean contents of tab characters
        For Each Cell In Selection.SpecialCells(xlCellTypeConstants, xlTextValues).Cells
            With Cell
                .Value = Application.WorksheetFunction.Substitute(.Value, vbTab, Chr(32))
                .Value = Application.WorksheetFunction.Substitute(.Value, "  ", " ")
            End With
        Next Cell
   
        For Each Ws In Sheets
            Ws.Name = IndClientDataBook.ActiveSheet.Range("H2").Value
        Next Ws
              
        'Save new workbook
        FPath = Application.ActiveWorkbook.Path
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        FName = ActiveSheet.Name
        WellnessCheckDateRange = vInputDateRange
        Application.ActiveWorkbook.SaveAs Filename:=(FName & " " & WellnessCheckDateRange), FileFormat:=51
        Application.ActiveWorkbook.Close False
        End With
    Next x
       
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
           
    'Delete the name list after macro is finished
    Application.DisplayAlerts = False
    DataBook.Sheets(NameList).Delete
    Application.DisplayAlerts = True
   
    'Turn off filter
    DataBook.Sheets(sht).Activate
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8
   
    'sBadFileFormatPath = Application.ActiveWorkbook.Path - I had this in to try and delete the file that saves with a dodgy file format, but it doesn't work so I've commented it out for now
   
    'Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Set objFolder = objFSO.GetFolder(sBadFileFormatPath)
   
    ''delete the data workbook that has the *.xls* characters in the file name
    'For Each objFile In objFolder.Files
    'If InStr(objFile.Name, "*.xlsx WITH MACROS") > 0 Then
    '    Application.DisplayAlerts = False
    '    Kill objFolder & objFile
    '    Application.DisplayAlerts = True
    'End If
    'Next
   
    'Set objFolder = Nothing
    'Set objFile = Nothing
    'Set objFSO = Nothing
       
End Sub