Update Values in Userform when filter is changed

[Macdave_19]

Hi folks,

here's my new dilema!

I have a userform which has 4 criteria at the top that filters data.

from that data i get a reference number and that is automatically placed into a cell.

that is then used to do a Vlookup and these lookups then complete the userform textboxes.

however if i change the filter it doesn't update the textboxes?

here's my code:

Private Sub CmdFilter_Click()

Dim Sprod As String
If FrmNew.CBProduct.Value = "Electricity" Then
Sprod = "E"
ElseIf FrmNew.CBProduct.Value = "Gas" Then
Sprod = "G"
End If

Application.ScreenUpdating = True
'select worksheet dependant on account type
    If FrmNew.CBAccType.Value = "Touched" Then
        Worksheets("Touched Work").Select
    ElseIf FrmNew.CBAccType.Value = "Dayfiled" Then
        Worksheets("Dayfiled").Select
    End If
'filter data by product
    If FrmNew.CBProduct.Value = "Electricity" Then
        Selection.AutoFilter Field:=13, Criteria1:="E"
    ElseIf FrmNew.CBProduct.Value = "Gas" Then
        Selection.AutoFilter Field:=13, Criteria1:="G"
    End If
'filter remaining data by age
    If FrmNew.CBAccAge.Value = "Oldest" Then
    Range("AT1").Select
    Range("A1:CN7707").Sort Key1:=Range("AT1"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    ElseIf FrmNew.CBAccAge.Value = "Newest" Then
    Range("AT1").Select
    Range("A1:CN7707").Sort Key1:=Range("AT1"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End If
    
'filter by billing type
    If FrmNew.CBBilling.Value = "Monthly" Then
        Selection.AutoFilter Field:=33, Criteria1:="Monthly"
    ElseIf FrmNew.CBBilling.Value = "Quarterly" Then
        Selection.AutoFilter Field:=33, Criteria1:="Quarterly"
    End If
    
'select which sheet to pull the data from
    If FrmNew.CBAccType.Value = "Touched" Then
        Worksheets("Touched work").Select
    ElseIf FrmNew.CBAccType.Value = "Dayfiled" Then
        Worksheets("Dayfiled").Select
    End If
    
    Range("E2").Select
        Do Until ActiveCell.Offset(0, 8).Value = Sprod
        ActiveCell.Offset(1, 0).Select
        Loop
        Application.ScreenUpdating = True
            Worksheets("Cover").Range("A6").Value = ActiveCell.Offset(0, 3).Value 'Bill Status
            Worksheets("Cover").Range("A8").Value = ActiveCell.Offset(0, 1).Value 'New Flag
            Worksheets("Cover").Range("A10").Value = ActiveCell.Offset(0, 65).Value ' Port Rec
            Worksheets("Cover").Range("A12").Value = ActiveCell.Offset(0, 68).Value ' Unbilled Value
            Worksheets("Cover").Range("A14").Value = ActiveCell.Offset(0, 20).Value ' Company Name
            Worksheets("Cover").Range("A16").Value = ActiveCell.Offset(0, 66).Value ' Unbilled Reason
            Worksheets("Cover").Range("A4").Value = ActiveCell.Value
'add the data into the userform
            Worksheets("Cover").Range("A2").Value = FrmNew.CBAccType.Value
            
            FrmNew.TxtCRN.Value = Worksheets("Cover").Range("A4").Value
            FrmNew.TxtBillStatus.Value = Worksheets("Cover").Range("A6").Value
            FrmNew.TxtFlag.Value = Worksheets("Cover").Range("A8").Value
            FrmNew.TxtPRec.Value = Worksheets("Cover").Range("A10").Value
            FrmNew.TxtUnVal.Value = Worksheets("Cover").Range("A12").Value
            FrmNew.TxtCname.Value = Worksheets("Cover").Range("A14").Value
            FrmNew.TxtReason.Value = Worksheets("Cover").Range("A16").Value

        Worksheets("Cover").Activate
End Sub

Private Sub UserForm_Initialize()

FrmNew.CBAccType.AddItem "Touched"
FrmNew.CBAccType.AddItem "Dayfiled"

FrmNew.CBProduct.AddItem "Electricity"
FrmNew.CBProduct.AddItem "Gas"

FrmNew.CBAccAge.AddItem "Oldest"
FrmNew.CBAccAge.AddItem "Newest"

FrmNew.CBRoot.AddItem "BER Amendment"
FrmNew.CBRoot.AddItem "Cross License Tranfer"
FrmNew.CBRoot.AddItem "Crossed MTR"
FrmNew.CBRoot.AddItem "Datafix"
FrmNew.CBRoot.AddItem "De-aggregation Issue"
FrmNew.CBRoot.AddItem "Demolition"
FrmNew.CBRoot.AddItem "Duplicate"
FrmNew.CBRoot.AddItem "EP Mismatch"
FrmNew.CBRoot.AddItem "ET"
FrmNew.CBRoot.AddItem "GUTO Issue"
FrmNew.CBRoot.AddItem "Isolation Issue"
FrmNew.CBRoot.AddItem "Late Set Up"
FrmNew.CBRoot.AddItem "Metering issue/Dispute"
FrmNew.CBRoot.AddItem "Migration Issue"
FrmNew.CBRoot.AddItem "New Connection"
FrmNew.CBRoot.AddItem "Portfolio Rec"
FrmNew.CBRoot.AddItem "Registration Issue"
FrmNew.CBRoot.AddItem "Script Errors"
FrmNew.CBRoot.AddItem "Split Accounts"
FrmNew.CBRoot.AddItem "Unoccupied Account"
FrmNew.CBRoot.AddItem "Unsupported Meter"

FrmNew.CBBilling.AddItem "Monthly"
FrmNew.CBBilling.AddItem "Quarterly"

Dim lpbuff As String * 25
Dim ret As Long
Dim StrName As String
Dim StrSheet As String
StrSheet = FrmNew.CBAccType.Value
ret = GetUserName(lpbuff, 25)
StrName = Left(lpbuff, InStr(lpbuff, Chr(0)) - 1)
FrmNew.TxtKID.Value = StrName

End Sub

Thanks for reading my thread and thanks to that that help or at least try to

[royUK]

I have had a go at interpreting your code. Test this

Option Explicit

Dim Sprod      As String
Dim lpbuff     As String * 25
Dim ret        As Long
Dim StrName    As String
Dim StrSheet   As String
Private Sub CmdFilter_Click()
    Dim ws     As Worksheet
    Dim rFilter As Range
    Dim rCl    As Range
    Dim R      As Long
    If Sprod = "" Then
        MsgBox "Please select a product", vbCritical, "Ripoff Utilities"
        Me.CBproduct.SetFocus
    End If

    Set ws = Worksheets("Cover")

    Application.ScreenUpdating = True
    'select worksheet dependant on account type
    'It is not really necessary to select a sheet.
    If Me.cbAccType.Value = "Touched" Then
        Worksheets("Touched Work").Select
    ElseIf Me.cbAccType.Value = "Dayfiled" Then
        Worksheets("Dayfiled").Select
    End If
    'filter data by product
    If Me.CBproduct.Value = "Electricity" Then
        Selection.AutoFilter Field:=13, Criteria1:="E"
    ElseIf Me.CBproduct.Value = "Gas" Then
        Selection.AutoFilter Field:=13, Criteria1:="G"
    End If
    'filter remaining data by age
    If Me.CBAccAge.Value = "Oldest" Then
        Range("AT1").Select
        Range("A1:CN7707").Sort Key1:=Range("AT1"), Order1:=xlDescending, Header:= _
                                xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                DataOption1:=xlSortNormal
    ElseIf Me.CBAccAge.Value = "Newest" Then
        Range("AT1").Select
        Range("A1:CN7707").Sort Key1:=Range("AT1"), Order1:=xlAscending, Header:= _
                                xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                DataOption1:=xlSortNormal
    End If

    'filter by billing type
    If Me.CBBilling.Value = "Monthly" Then
        Selection.AutoFilter Field:=33, Criteria1:="Monthly"
    ElseIf Me.CBBilling.Value = "Quarterly" Then
        Selection.AutoFilter Field:=33, Criteria1:="Quarterly"
    End If

    'select which sheet to pull the data from
    If Me.cbAccType.Value = "Touched" Then
        Worksheets("Touched work").Select
    ElseIf Me.cbAccType.Value = "Dayfiled" Then
        Worksheets("Dayfiled").Select
    End If


    'need on error in case no visible cells
    On Error Resume Next
    Set rFilter = Cells.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    'now find the product
    'this will finf "G" or "E"
    Set rCl = rFilter.Find(Sprod, LookIn:=xlValues)
    'get the row number, use to populate textboxes
    If Not rCl Is Nothing Then R = rCl.Row


    Application.ScreenUpdating = True
    With ws
        .Range("A6").Value = Cells(R, 8).Value    'Bill Status
        .Range("A8").Value = Cells(R, 6).Value    'New Flag
        .Range("A10").Value = Cells(R, 70).Value    ' Port Rec
        .Range("A12").Value = Cells(R, 73).Value    ' Unbilled Value
        .Range("A14").Value = Cells(R, 25).Value    ' Company Name
        .Range("A16").Value = Cells(R, 71).Value    ' Unbilled Reason
        .Range("A4").Value = Cells(R, 5).Value
        'add the data into the userform
        .Range("A2").Value = Me.cbAccType.Value
    End With
    With Me
        .TxtCRN.Value = ws.Range("A4").Value
        .TxtBillStatus.Value = ws.Range("A6").Value
        .TxtFlag.Value = ws.Range("A8").Value
        .TxtPRec.Value = ws.Range("A10").Value
        .TxtUnVal.Value = ws.Range("A12").Value
        .TxtCname.Value = ws.Range("A14").Value
        .TxtReason.Value = ws.Range("A16").Value
    End With
    ws.Activate
End Sub

Private Sub CBproduct_Change()
    'determine sProd
    Select Case Me.CBproduct.ListIndex
        Case 0: Sprod = "E"
        Case 1: Sprod = "G"
        Case Else
    End Select
End Sub

Private Sub UserForm_Initialize()

    With Me
        .cbAccType.List = Array("Touched", "Dayfiled")
        .CBproduct.List = Array("Electricity", "Gas")
        .CBAccAge.List = Array("Oldest", "Newest")
        .CBRoot.List = Array("BER Amendment", "Cross License Tranfer", "Crossed MTR", _
                             "Datafix", "De-aggregation Issue", "Demolition", "Duplicate", "EP Mismatch", _
                             "ET", "GUTO Issue", "Isolation Issue", "Metering issue/Dispute", _
                             "Migration Issue", "New Connection", "Portfolio Rec", "Registration Issue", _
                             "Script Errors", "Split Accounts", "Unoccupied Account", "Unsupported Meter")
        .CBBilling.List = Array("Monthly", "Quarterly")


        StrSheet = .cbAccType.Value
        ret = GetUserName(lpbuff, 25)
        StrName = Left(lpbuff, InStr(lpbuff, Chr(0)) - 1)
        .TxtKID.Value = StrName

    End Sub