Search for values using an advanced search and update then display pivot table results in a userform listbox

Rfriend

Board Regular
Joined
May 10, 2021
Messages
73
Office Version
  1. 2010
Platform
  1. Windows
Hello,

I am trying to add 2 listboxs in my userform that show training hours conducted by department on a monh and YTD basis. I have had some luck, but the code is not really getting me there.

In short,
  1. PvtTbl1 - is used to search hours of training by month and department.
  2. PvtTbl2 - is used to display training completed (see attached), by month & fiscal or by all training hours, depending on what is or is not entered into control cboPvt2, for each department for review by department managerment in review of KPI's.
The code I have been trying to manipulate is below, but I cannot get the pivot table to update when the search command is selected or display the newly requested data in the two listboxes.
  • I should be able to select and search by a fiscal year (FY) with control cboPvt2 to display only training hours from the period searched (i.e FY2023) within the listbox, PvtTbl1
  • I should be able to select a department in control cboPvt1 and return a list of all/any supervisors within the selected department in listbox PvtTbl2
    • The department does not affect pvtTbl1, and the year does not affect pvtTbl2
I am not trying to create a new pivot table with each update, nor add to the table through a userform directly updating the pivot tables, which is all I can find online.
I need to search the running database by specific criteria with using a search control and an advanced filter, then refresh the pivot table with the requested data displaying the results in the listboxes on my userform.

Any help is appreciated.

Thank you

VBA Code:
[B]Private Sub UserForm_Initialize()[/B]
    ClearRpt
    txtRec_Num1.Text = Sheet18.Range("T6").Value
    With Me
        .cboRpt1.Enabled = True
        .cboRpt1.BackColor = RGB(15, 255, 15)
        .txtRpt3.Enabled = True
        .txtRpt3.BackColor = RGB(15, 255, 15)
        .txtRpt1.Enabled = False
        .txtRpt1.BackColor = RGB(8, 8, 0)
        .txtRpt2.Enabled = False
        .txtRpt2.BackColor = RGB(8, 8, 0)
    End With
End Sub

[B]Private Sub cmdTrngPvt_Click()[/B]
PvtSearch
End Sub

[B]Sub PvtSearch()[/B]
'Sheet15 = PvtTrng
'Sheet18 = TrngRpt
'Sheet21 = PvtSearch
    Dim PvtTrngSH As Worksheet
    Dim PvtSearchSH As Worksheet
    On Error GoTo errHandler:
        Set PvtTrngSH = sheet15
        Set PvtSearchSH = Sheet21
            Application.ScreenUpdating = False
                'UnProtect_All
                'ProgressBar
                        PvtSearchSH.Range("K6") = Me.pvt1.Value 'Program
                        PvtSearchSH.Range("L6") = Me.pvt2.Value 'FY
                    
                       'FY
                        Sheet8.Range("HistData4[#All]").AdvancedFilter Action:=xlFilterCopy, _
                        CriteriaRange:=Sheet21.Range("L5:L6"), CopyToRange:=Sheet21.Range("P6:U6"), Unique:=False
                        TrngPvt1.RowSource = sheet15.Range("TrngPvtHrs").Address(external:=True)
                        
                       'Program
                        Sheet8.Range("HistData4[#All]").AdvancedFilter Action:=xlFilterCopy, _
                        CriteriaRange:=Sheet21.Range("K5:K6"), CopyToRange:=Sheet21.Range("D6:I6"), Unique:=False
                        TrngPvt2.RowSource = sheet15.Range("TrngPvtDept").Address(external:=True)
                    RefreshPvtAll
            'DoEvents
        'Protect_All
    Exit Sub 
errHandler::
    'Protect_All
        MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
        & Err.Number & vbCrLf & Err.Description & vbCrLf
    Exit Sub
End Sub

[B]Sub RefreshPvtAll()[/B]
    'UnProtect_All
        ActiveWorkbook.RefreshAll
    'Protect_All
End Sub
 

Attachments

  • Capture.JPG
    Capture.JPG
    157.2 KB · Views: 16
  • Capture 2.JPG
    Capture 2.JPG
    81.3 KB · Views: 14

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

Forum statistics

Threads
1,215,076
Messages
6,122,984
Members
449,092
Latest member
Mr Hughes

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top