Ideas how to display a filtered list …

[adambc]

I have a table with 20 columns - records are added via a UserForm which allocates a sequential unique key to each new record (Column A) …

Records are updated via another UserForm - users click on the unique key in column A, then a button which invokes the UserForm …

The Command Button options on the UserForm are “Cancel” (which unloads the UserForm without saving changes after a Y/N MsgBox warning dialogue) - and “Save” which does two things (three if you the check for changes which reverts to “Cancel” if there are none) …

i) the current record is copied to the next empty row in a table (“History Log”) on another Worksheet - Date/Time and Username are added to the copied record …

ii) the current record is overwritten by the data from the UserForm …

This all works well and users can filter the History Log to see any updates to the record, but users are getting quite clumsy in their filtering of the History Log and I’m looking for a way to control this …

Is it possible to pass a variable (the record unique key) to a VBA routine that does the filtering automatically and then resets the filtering once the user has finished - and before you start telling me I’m being vague, I know!

I have thought about populating a child UserForm with up to (say) the latest 6 updates, but with 20 columns that could be a bit messy! …

Hence this post to see if anyone has any ideas?

Many thanks in advance …

 

[igold]

I don't know why you would want to be intentionally vague when you are looking for help...
At any rate I have question: Is the filtered History Log, read only, or do you want your users to be able to edit the filtered records.

 

[adambc]

I don't know why you would want to be intentionally vague when you are looking for help...
At any rate I have question: Is the filtered History Log, read only, or do you want your users to be able to edit the filtered records.

Because I wasn’t sure what is possible, not because I wanted to be vague!

Read only - since my post, I’ve been looking at UserForms with a ListBox, with AutoFilter - just need to figure out how to only display filtered rows?

 

[igold]

Fair enough. A few more questions: The "History Log" is indeed a table and not a range of data. If so, what is the name of the table and what is the name of the sheet the table is on and is it the only table on the sheet...

 

[adambc]

Fair enough. A few more questions: The "History Log" is indeed a table and not a range of data. If so, what is the name of the table and what is the name of the sheet the table is on and is it the only table on the sheet...

Yes, it’s a table …

Worksheet = “History Log” (with a space) ..,

Table = “HistoryLog” (without a space) …

I’ve got the ListBox working with Column Headers - but even though the Table is filtered, it’s still bringing through the unfiltered Table …

Thanks …

 

[igold]

This is not exactly what you asked for- a userform with a listbox. What this will do is add a new sheet to your workbook which is populated with the data from the History Log Table filtered by the selected sequential unique number (active cell). The worksheet will be named whatever the active cell value is. Additionally, the new sheet will also have it's own "Delete" button that will delete the sheet and return the user to the History log tab. I am including my test sheet which is just a 20 column table of jibberish with a unique number in column A, which is randomly repeated the way I am picturing your History Table. If you are not using XL2BB then you may want to create your own test table. Please be sure to folllow the naming of table and worksheet as you posted in your post #5.

Sub IndkeyInfoSub()

    Dim key As String
    Dim wsHL As Worksheet: Set wsHL = Worksheets("History Log")
    Dim wAs As Worksheet
    Dim tbl As ListObject: Set tbl = wsHL.ListObjects("HistoryLog")
    Dim i As Long, n As Long, r As Long
    Dim shp As Object
    Dim arr, arr2, hdr

    Application.ScreenUpdating = False
    If ActiveCell.Value = "" Or ActiveCell.Column <> 1 Then
        MsgBox "You must click on a unique key to look up!"
        Application.ScreenUpdating = True
        Exit Sub
    End If
    key = ActiveCell.Value
    arr = tbl.DataBodyRange.Resize(tbl.ListRows.Count, tbl.ListColumns.Count)
    ReDim arr2(1 To tbl.ListRows.Count, 1 To tbl.ListColumns.Count)

'******************************************
'Create New Worksheet
'******************************************
    Sheets.Add.Name = key
    Set wAs = Worksheets(key)

'**************************************
'Copy & Paste key Details
'**************************************
    hdr = wsHL.Range("A1:T1")
    wAs.Range("A1:T1") = hdr

    n = 1
    For i = 1 To UBound(arr)
        If arr(i, 1) = key Then
            For r = 1 To UBound(arr, 2)
                arr2(n, r) = arr(i, r)
            Next
            n = n + 1
        End If
    Next
    wAs.Range("A2").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2

'******************************************
'Create Command Button
'******************************************
    With wAs
        .Shapes.AddShape 62, 1100, 50, 120, 30
        .Shapes(1).Select
    End With
    Set shp = wAs.Shapes(1)
    With Selection
        .Name = "Delete Sheet Button"
        .OnAction = "DeleteSheet"
        .Characters.Text = "Delete Sheet"
        .Font.Color = RGB(100, 150, 175)
        .Font.Size = 16
        .HorizontalAlignment = xlCenter
        .Interior.Color = RGB(200, 200, 200)
    End With
    wAs.UsedRange.Select
ErrHandler:
    
    Range("A1").Select
    Application.ScreenUpdating = True

End Sub

Sub DeleteSheet()
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    Worksheets("History Log").Activate
End Sub

CreateSheet.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	Seq Key	Column2	Column3	Column4	Column5	Column6	Column7	Column8	Column9	Column10	Column11	Column12	Column13	Column14	Column15	Column16	Column17	Column18	Column19	Column20
2	2A1	B1	C2	D2	E2	F2	G2	H2	I2	J2	K2	L2	M2	N2	O2	P2	Q2	R2	S2	T2
3	3A1	B2	C3	D3	E3	F3	G3	H3	I3	J3	K3	L3	M3	N3	O3	P3	Q3	R3	S3	T3
4	4A1	B3	C4	D4	E4	F4	G4	H4	I4	J4	K4	L4	M4	N4	O4	P4	Q4	R4	S4	T4
5	5A1	B4	C5	D5	E5	F5	G5	H5	I5	J5	K5	L5	M5	N5	O5	P5	Q1	R5	S5	T5
6	6A1	B5	C6	D6	E6	F6	G6	H6	I6	J6	K6	L6	M6	N6	O6	P6	Q2	R6	S6	T6
7	2A1	B6	C7	D7	E7	F7	G7	H7	I7	J7	K7	L7	M7	N7	O7	P7	Q3	R7	S7	T7
8	3A1	B7	C8	D8	E8	F8	G8	H8	I8	J8	K8	L8	M8	N8	O8	P8	Q4	R8	S8	T8
9	4A1	B8	C9	D9	E9	F9	G9	H9	I9	J9	K9	L9	M9	N9	O9	P9	Q1	R9	S9	T9
10	5A1	B9	C10	D10	E10	F10	G10	H10	I10	J10	K10	L10	M10	N10	O10	P10	Q2	R10	S10	T10
11	6A1	B10	C11	D11	E11	F11	G11	H11	I11	J11	K11	L11	M11	N11	O11	P11	Q3	R11	S11	T11
12	2A1	B11	C12	D12	E12	F12	G12	H12	I12	J12	K12	L12	M12	N12	O12	P12	Q4	R12	S12	T12
13	3A1	B12	C13	D13	E13	F13	G13	H13	I13	J13	K13	L13	M13	N13	O13	P13	Q1	R13	S13	T13
14	4A1	B13	C14	D14	E14	F14	G14	H14	I14	J14	K14	L14	M14	N14	O14	P14	Q2	R14	S14	T14
15	5A1	B14	C15	D15	E15	F15	G15	H15	I15	J15	K15	L15	M15	N15	O15	P15	Q3	R15	S15	T15
16	6A1	B15	C16	D16	E16	F16	G16	H16	I16	J16	K16	L16	M16	N16	O16	P16	Q4	R16	S16	T16
17	2A1	B16	C17	D17	E17	F17	G17	H17	I17	J17	K17	L17	M17	N17	O17	P17	Q1	R17	S17	T17
18	3A1	B17	C18	D18	E18	F18	G18	H18	I18	J18	K18	L18	M18	N18	O18	P18	Q2	R18	S18	T18
19	4A1	B18	C19	D19	E19	F19	G19	H19	I19	J19	K19	L19	M19	N19	O19	P19	Q3	R19	S19	T19
20	5A1	B19	C20	D20	E20	F20	G20	H20	I20	J20	K20	L20	M20	N20	O20	P20	Q4	R20	S20	T20
21	6A1	B20	C21	D21	E21	F21	G21	H21	I21	J21	K21	L21	M21	N21	O21	P21	Q1	R21	S21	T21
22	2A1	B21	C22	D22	E22	F22	G22	H22	I22	J22	K22	L22	M22	N22	O22	P22	Q2	R22	S22	T22
23	3A1	B22	C23	D23	E23	F23	G23	H23	I23	J23	K23	L23	M23	N23	O23	P23	Q3	R23	S23	T23
24	4A1	B23	C24	D24	E24	F24	G24	H24	I24	J24	K24	L24	M24	N24	O24	P24	Q4	R24	S24	T24
25	5A1	B24	C25	D25	E25	F25	G25	H25	I25	J25	K25	L25	M25	N25	O25	P25	Q1	R25	S25	T25
26	6A1	B25	C26	D26	E26	F26	G26	H26	I26	J26	K26	L26	M26	N26	O26	P26	Q2	R26	S26	T26
27	2A1	B26	C27	D27	E27	F27	G27	H27	I27	J27	K27	L27	M27	N27	O27	P27	Q3	R27	S27	T27
28	3A1	B27	C28	D28	E28	F28	G28	H28	I28	J28	K28	L28	M28	N28	O28	P28	Q4	R28	S28	T28
29	4A1	B28	C29	D29	E29	F29	G29	H29	I29	J29	K29	L29	M29	N29	O29	P29	Q1	R29	S29	T29
30	5A1	B29	C30	D30	E30	F30	G30	H30	I30	J30	K30	L30	M30	N30	O30	P30	Q2	R30	S30	T30
31	6A1	B30	C31	D31	E31	F31	G31	H31	I31	J31	K31	L31	M31	N31	O31	P31	Q3	R31	S31	T31
32	2A1	B31	C32	D32	E32	F32	G32	H32	I32	J32	K32	L32	M32	N32	O32	P32	Q4	R32	S32	T32
33	3A1	B32	C33	D33	E33	F33	G33	H33	I33	J33	K33	L33	M33	N33	O33	P33	Q1	R33	S33	T33
34	4A1	B33	C34	D34	E34	F34	G34	H34	I34	J34	K34	L34	M34	N34	O34	P34	Q2	R34	S34	T34
35	5A1	B34	C35	D35	E35	F35	G35	H35	I35	J35	K35	L35	M35	N35	O35	P35	Q3	R35	S35	T35
History Log

 

[adambc]

This is not exactly what you asked for- a userform with a listbox. What this will do is add a new sheet to your workbook which is populated with the data from the History Log Table filtered by the selected sequential unique number (active cell). The worksheet will be named whatever the active cell value is. Additionally, the new sheet will also have it's own "Delete" button that will delete the sheet and return the user to the History log tab. I am including my test sheet which is just a 20 column table of jibberish with a unique number in column A, which is randomly repeated the way I am picturing your History Table. If you are not using XL2BB then you may want to create your own test table. Please be sure to folllow the naming of table and worksheet as you posted in your post #5.

Sub IndkeyInfoSub()

    Dim key As String
    Dim wsHL As Worksheet: Set wsHL = Worksheets("History Log")
    Dim wAs As Worksheet
    Dim tbl As ListObject: Set tbl = wsHL.ListObjects("HistoryLog")
    Dim i As Long, n As Long, r As Long
    Dim shp As Object
    Dim arr, arr2, hdr

    Application.ScreenUpdating = False
    If ActiveCell.Value = "" Or ActiveCell.Column <> 1 Then
        MsgBox "You must click on a unique key to look up!"
        Application.ScreenUpdating = True
        Exit Sub
    End If
    key = ActiveCell.Value
    arr = tbl.DataBodyRange.Resize(tbl.ListRows.Count, tbl.ListColumns.Count)
    ReDim arr2(1 To tbl.ListRows.Count, 1 To tbl.ListColumns.Count)

'******************************************
'Create New Worksheet
'******************************************
    Sheets.Add.Name = key
    Set wAs = Worksheets(key)

'**************************************
'Copy & Paste key Details
'**************************************
    hdr = wsHL.Range("A1:T1")
    wAs.Range("A1:T1") = hdr

    n = 1
    For i = 1 To UBound(arr)
        If arr(i, 1) = key Then
            For r = 1 To UBound(arr, 2)
                arr2(n, r) = arr(i, r)
            Next
            n = n + 1
        End If
    Next
    wAs.Range("A2").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2

'******************************************
'Create Command Button
'******************************************
    With wAs
        .Shapes.AddShape 62, 1100, 50, 120, 30
        .Shapes(1).Select
    End With
    Set shp = wAs.Shapes(1)
    With Selection
        .Name = "Delete Sheet Button"
        .OnAction = "DeleteSheet"
        .Characters.Text = "Delete Sheet"
        .Font.Color = RGB(100, 150, 175)
        .Font.Size = 16
        .HorizontalAlignment = xlCenter
        .Interior.Color = RGB(200, 200, 200)
    End With
    wAs.UsedRange.Select
ErrHandler:
   
    Range("A1").Select
    Application.ScreenUpdating = True

End Sub

Sub DeleteSheet()
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    Worksheets("History Log").Activate
End Sub

CreateSheet.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	Seq Key	Column2	Column3	Column4	Column5	Column6	Column7	Column8	Column9	Column10	Column11	Column12	Column13	Column14	Column15	Column16	Column17	Column18	Column19	Column20
2	2A1	B1	C2	D2	E2	F2	G2	H2	I2	J2	K2	L2	M2	N2	O2	P2	Q2	R2	S2	T2
3	3A1	B2	C3	D3	E3	F3	G3	H3	I3	J3	K3	L3	M3	N3	O3	P3	Q3	R3	S3	T3
4	4A1	B3	C4	D4	E4	F4	G4	H4	I4	J4	K4	L4	M4	N4	O4	P4	Q4	R4	S4	T4
5	5A1	B4	C5	D5	E5	F5	G5	H5	I5	J5	K5	L5	M5	N5	O5	P5	Q1	R5	S5	T5
6	6A1	B5	C6	D6	E6	F6	G6	H6	I6	J6	K6	L6	M6	N6	O6	P6	Q2	R6	S6	T6
7	2A1	B6	C7	D7	E7	F7	G7	H7	I7	J7	K7	L7	M7	N7	O7	P7	Q3	R7	S7	T7
8	3A1	B7	C8	D8	E8	F8	G8	H8	I8	J8	K8	L8	M8	N8	O8	P8	Q4	R8	S8	T8
9	4A1	B8	C9	D9	E9	F9	G9	H9	I9	J9	K9	L9	M9	N9	O9	P9	Q1	R9	S9	T9
10	5A1	B9	C10	D10	E10	F10	G10	H10	I10	J10	K10	L10	M10	N10	O10	P10	Q2	R10	S10	T10
11	6A1	B10	C11	D11	E11	F11	G11	H11	I11	J11	K11	L11	M11	N11	O11	P11	Q3	R11	S11	T11
12	2A1	B11	C12	D12	E12	F12	G12	H12	I12	J12	K12	L12	M12	N12	O12	P12	Q4	R12	S12	T12
13	3A1	B12	C13	D13	E13	F13	G13	H13	I13	J13	K13	L13	M13	N13	O13	P13	Q1	R13	S13	T13
14	4A1	B13	C14	D14	E14	F14	G14	H14	I14	J14	K14	L14	M14	N14	O14	P14	Q2	R14	S14	T14
15	5A1	B14	C15	D15	E15	F15	G15	H15	I15	J15	K15	L15	M15	N15	O15	P15	Q3	R15	S15	T15
16	6A1	B15	C16	D16	E16	F16	G16	H16	I16	J16	K16	L16	M16	N16	O16	P16	Q4	R16	S16	T16
17	2A1	B16	C17	D17	E17	F17	G17	H17	I17	J17	K17	L17	M17	N17	O17	P17	Q1	R17	S17	T17
18	3A1	B17	C18	D18	E18	F18	G18	H18	I18	J18	K18	L18	M18	N18	O18	P18	Q2	R18	S18	T18
19	4A1	B18	C19	D19	E19	F19	G19	H19	I19	J19	K19	L19	M19	N19	O19	P19	Q3	R19	S19	T19
20	5A1	B19	C20	D20	E20	F20	G20	H20	I20	J20	K20	L20	M20	N20	O20	P20	Q4	R20	S20	T20
21	6A1	B20	C21	D21	E21	F21	G21	H21	I21	J21	K21	L21	M21	N21	O21	P21	Q1	R21	S21	T21
22	2A1	B21	C22	D22	E22	F22	G22	H22	I22	J22	K22	L22	M22	N22	O22	P22	Q2	R22	S22	T22
23	3A1	B22	C23	D23	E23	F23	G23	H23	I23	J23	K23	L23	M23	N23	O23	P23	Q3	R23	S23	T23
24	4A1	B23	C24	D24	E24	F24	G24	H24	I24	J24	K24	L24	M24	N24	O24	P24	Q4	R24	S24	T24
25	5A1	B24	C25	D25	E25	F25	G25	H25	I25	J25	K25	L25	M25	N25	O25	P25	Q1	R25	S25	T25
26	6A1	B25	C26	D26	E26	F26	G26	H26	I26	J26	K26	L26	M26	N26	O26	P26	Q2	R26	S26	T26
27	2A1	B26	C27	D27	E27	F27	G27	H27	I27	J27	K27	L27	M27	N27	O27	P27	Q3	R27	S27	T27
28	3A1	B27	C28	D28	E28	F28	G28	H28	I28	J28	K28	L28	M28	N28	O28	P28	Q4	R28	S28	T28
29	4A1	B28	C29	D29	E29	F29	G29	H29	I29	J29	K29	L29	M29	N29	O29	P29	Q1	R29	S29	T29
30	5A1	B29	C30	D30	E30	F30	G30	H30	I30	J30	K30	L30	M30	N30	O30	P30	Q2	R30	S30	T30
31	6A1	B30	C31	D31	E31	F31	G31	H31	I31	J31	K31	L31	M31	N31	O31	P31	Q3	R31	S31	T31
32	2A1	B31	C32	D32	E32	F32	G32	H32	I32	J32	K32	L32	M32	N32	O32	P32	Q4	R32	S32	T32
33	3A1	B32	C33	D33	E33	F33	G33	H33	I33	J33	K33	L33	M33	N33	O33	P33	Q1	R33	S33	T33
34	4A1	B33	C34	D34	E34	F34	G34	H34	I34	J34	K34	L34	M34	N34	O34	P34	Q2	R34	S34	T34
35	5A1	B34	C35	D35	E35	F35	G35	H35	I35	J35	K35	L35	M35	N35	O35	P35	Q3	R35	S35	T35
History Log

Thank you …

Won’t be able to try until Wednesday, but will let you know how I get on then …

 

[adambc]

This is not exactly what you asked for- a userform with a listbox. What this will do is add a new sheet to your workbook which is populated with the data from the History Log Table filtered by the selected sequential unique number (active cell). The worksheet will be named whatever the active cell value is. Additionally, the new sheet will also have it's own "Delete" button that will delete the sheet and return the user to the History log tab. I am including my test sheet which is just a 20 column table of jibberish with a unique number in column A, which is randomly repeated the way I am picturing your History Table. If you are not using XL2BB then you may want to create your own test table. Please be sure to folllow the naming of table and worksheet as you posted in your post #5.

Sub IndkeyInfoSub()

    Dim key As String
    Dim wsHL As Worksheet: Set wsHL = Worksheets("History Log")
    Dim wAs As Worksheet
    Dim tbl As ListObject: Set tbl = wsHL.ListObjects("HistoryLog")
    Dim i As Long, n As Long, r As Long
    Dim shp As Object
    Dim arr, arr2, hdr

    Application.ScreenUpdating = False
    If ActiveCell.Value = "" Or ActiveCell.Column <> 1 Then
        MsgBox "You must click on a unique key to look up!"
        Application.ScreenUpdating = True
        Exit Sub
    End If
    key = ActiveCell.Value
    arr = tbl.DataBodyRange.Resize(tbl.ListRows.Count, tbl.ListColumns.Count)
    ReDim arr2(1 To tbl.ListRows.Count, 1 To tbl.ListColumns.Count)

'******************************************
'Create New Worksheet
'******************************************
    Sheets.Add.Name = key
    Set wAs = Worksheets(key)

'**************************************
'Copy & Paste key Details
'**************************************
    hdr = wsHL.Range("A1:T1")
    wAs.Range("A1:T1") = hdr

    n = 1
    For i = 1 To UBound(arr)
        If arr(i, 1) = key Then
            For r = 1 To UBound(arr, 2)
                arr2(n, r) = arr(i, r)
            Next
            n = n + 1
        End If
    Next
    wAs.Range("A2").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2

'******************************************
'Create Command Button
'******************************************
    With wAs
        .Shapes.AddShape 62, 1100, 50, 120, 30
        .Shapes(1).Select
    End With
    Set shp = wAs.Shapes(1)
    With Selection
        .Name = "Delete Sheet Button"
        .OnAction = "DeleteSheet"
        .Characters.Text = "Delete Sheet"
        .Font.Color = RGB(100, 150, 175)
        .Font.Size = 16
        .HorizontalAlignment = xlCenter
        .Interior.Color = RGB(200, 200, 200)
    End With
    wAs.UsedRange.Select
ErrHandler:
   
    Range("A1").Select
    Application.ScreenUpdating = True

End Sub

Sub DeleteSheet()
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    Worksheets("History Log").Activate
End Sub

CreateSheet.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	Seq Key	Column2	Column3	Column4	Column5	Column6	Column7	Column8	Column9	Column10	Column11	Column12	Column13	Column14	Column15	Column16	Column17	Column18	Column19	Column20
2	2A1	B1	C2	D2	E2	F2	G2	H2	I2	J2	K2	L2	M2	N2	O2	P2	Q2	R2	S2	T2
3	3A1	B2	C3	D3	E3	F3	G3	H3	I3	J3	K3	L3	M3	N3	O3	P3	Q3	R3	S3	T3
4	4A1	B3	C4	D4	E4	F4	G4	H4	I4	J4	K4	L4	M4	N4	O4	P4	Q4	R4	S4	T4
5	5A1	B4	C5	D5	E5	F5	G5	H5	I5	J5	K5	L5	M5	N5	O5	P5	Q1	R5	S5	T5
6	6A1	B5	C6	D6	E6	F6	G6	H6	I6	J6	K6	L6	M6	N6	O6	P6	Q2	R6	S6	T6
7	2A1	B6	C7	D7	E7	F7	G7	H7	I7	J7	K7	L7	M7	N7	O7	P7	Q3	R7	S7	T7
8	3A1	B7	C8	D8	E8	F8	G8	H8	I8	J8	K8	L8	M8	N8	O8	P8	Q4	R8	S8	T8
9	4A1	B8	C9	D9	E9	F9	G9	H9	I9	J9	K9	L9	M9	N9	O9	P9	Q1	R9	S9	T9
10	5A1	B9	C10	D10	E10	F10	G10	H10	I10	J10	K10	L10	M10	N10	O10	P10	Q2	R10	S10	T10
11	6A1	B10	C11	D11	E11	F11	G11	H11	I11	J11	K11	L11	M11	N11	O11	P11	Q3	R11	S11	T11
12	2A1	B11	C12	D12	E12	F12	G12	H12	I12	J12	K12	L12	M12	N12	O12	P12	Q4	R12	S12	T12
13	3A1	B12	C13	D13	E13	F13	G13	H13	I13	J13	K13	L13	M13	N13	O13	P13	Q1	R13	S13	T13
14	4A1	B13	C14	D14	E14	F14	G14	H14	I14	J14	K14	L14	M14	N14	O14	P14	Q2	R14	S14	T14
15	5A1	B14	C15	D15	E15	F15	G15	H15	I15	J15	K15	L15	M15	N15	O15	P15	Q3	R15	S15	T15
16	6A1	B15	C16	D16	E16	F16	G16	H16	I16	J16	K16	L16	M16	N16	O16	P16	Q4	R16	S16	T16
17	2A1	B16	C17	D17	E17	F17	G17	H17	I17	J17	K17	L17	M17	N17	O17	P17	Q1	R17	S17	T17
18	3A1	B17	C18	D18	E18	F18	G18	H18	I18	J18	K18	L18	M18	N18	O18	P18	Q2	R18	S18	T18
19	4A1	B18	C19	D19	E19	F19	G19	H19	I19	J19	K19	L19	M19	N19	O19	P19	Q3	R19	S19	T19
20	5A1	B19	C20	D20	E20	F20	G20	H20	I20	J20	K20	L20	M20	N20	O20	P20	Q4	R20	S20	T20
21	6A1	B20	C21	D21	E21	F21	G21	H21	I21	J21	K21	L21	M21	N21	O21	P21	Q1	R21	S21	T21
22	2A1	B21	C22	D22	E22	F22	G22	H22	I22	J22	K22	L22	M22	N22	O22	P22	Q2	R22	S22	T22
23	3A1	B22	C23	D23	E23	F23	G23	H23	I23	J23	K23	L23	M23	N23	O23	P23	Q3	R23	S23	T23
24	4A1	B23	C24	D24	E24	F24	G24	H24	I24	J24	K24	L24	M24	N24	O24	P24	Q4	R24	S24	T24
25	5A1	B24	C25	D25	E25	F25	G25	H25	I25	J25	K25	L25	M25	N25	O25	P25	Q1	R25	S25	T25
26	6A1	B25	C26	D26	E26	F26	G26	H26	I26	J26	K26	L26	M26	N26	O26	P26	Q2	R26	S26	T26
27	2A1	B26	C27	D27	E27	F27	G27	H27	I27	J27	K27	L27	M27	N27	O27	P27	Q3	R27	S27	T27
28	3A1	B27	C28	D28	E28	F28	G28	H28	I28	J28	K28	L28	M28	N28	O28	P28	Q4	R28	S28	T28
29	4A1	B28	C29	D29	E29	F29	G29	H29	I29	J29	K29	L29	M29	N29	O29	P29	Q1	R29	S29	T29
30	5A1	B29	C30	D30	E30	F30	G30	H30	I30	J30	K30	L30	M30	N30	O30	P30	Q2	R30	S30	T30
31	6A1	B30	C31	D31	E31	F31	G31	H31	I31	J31	K31	L31	M31	N31	O31	P31	Q3	R31	S31	T31
32	2A1	B31	C32	D32	E32	F32	G32	H32	I32	J32	K32	L32	M32	N32	O32	P32	Q4	R32	S32	T32
33	3A1	B32	C33	D33	E33	F33	G33	H33	I33	J33	K33	L33	M33	N33	O33	P33	Q1	R33	S33	T33
34	4A1	B33	C34	D34	E34	F34	G34	H34	I34	J34	K34	L34	M34	N34	O34	P34	Q2	R34	S34	T34
35	5A1	B34	C35	D35	E35	F35	G35	H35	I35	J35	K35	L35	M35	N35	O35	P35	Q3	R35	S35	T35
History Log

@igold

Many thanks again for taking the trouble to reply to my post ...

As you say, not exactly what I asked for, but it got me thinking!

And the result is a UserForm with a ListBox and a CommandButton driven by the following code (it is called from another UserForm that has already checked that a KEY has been selected as the ActiveCell) - it works a treat!

NB; I know there are a couple of redundant steps, but I wanted the code to read clearly for future eyes!

Public SName As String

Private Sub UserForm_Initialize()

'Disable X on UserForm (use Close button to exit)

Call SystemButtonSettings(Me, False)

'Add temporary Worksheet AFTER last Worksheet (deleted when UserForm closed)

ACell = ActiveCell.value
CUser = Application.UserName
SName = ACell & " - " & CUser

Sheets.Add.Name = SName
Sheets(SName).Move After:=Sheets(Sheets.Count)

'Copy History Log table to temporary Worksheet

Sheets("History Log").ListObjects("HistoryLog").Range.Copy _
Destination:=Sheets(SName).Range("A1")

'Rename table on temporary Worksheet

Sheets(SName).ListObjects(1).Name = "HistoryLogFiltered"

'Filter on AND delete rows where Inventory ID NOT = selected KEY

With Sheets(SName)
    With .ListObjects("HistoryLogFiltered").DataBodyRange
        .AutoFilter
        .AutoFilter Field:=3, Criteria1:="<>" & ACell
        .EntireRow.Delete
        .AutoFilter
    End With
End With

'Temporary Worksheet = ActiveSheet

Sheets(SName).Select

'Set up and display ListBox with history for selected KEY ONLY

Dim wsSName As Worksheet
Dim rnghlf As Range

Set wsSName = Sheets(SName)
Set rnghlf = wsSName.Range("HistoryLogFiltered")

cols = Sheets(SName).Cells(1, Columns.Count).End(xlToLeft).Column

With ListBox1
    .ColumnCount = cols
    .ColumnHeads = True
    .RowSource = rnghlf.Address
End With

End Sub


Private Sub cmdClose_Click()

Application.DisplayAlerts = False

'Delete temporary Worksheet

Sheets(SName).Delete

Application.DisplayAlerts = True

'"All Devices" Worksheet = ActiveSheet (ActiveCell = selected KEY)

Worksheets("All Devices").Activate

Unload Me

End Sub

 

[igold]

You're welcome, I am glad that you were able to get something that works for you, that was the ultimate goal. Thanks for the feedback!