Looping through Listboxes

[senorcalidad]

Hi All,

I am working on generating a stock management system which utilises a visual map to represent storage boxes.
As such I am setting up VBA to filter through the list of all stock and display each in their respective boxes.
The boxes are labelled A - P and will be generated in Userforms showing list boxes.
Currently the VBA script I have for filtering and displaying in the listboxes is;

Private Sub cmb_stockmap_Click()

Dim dsh As Worksheet
Dim sh As Worksheet

Set dsh = ThisWorkbook.Sheets("Product_Master")
Set sh = ThisWorkbook.Sheets("Stock_Maps")

dsh.AutoFilterMode = False

If Me.txt_tankID.Value = "" Then
MsgBox "Please enter Tank ID"
End If

dsh.UsedRange.AutoFilter 3, "=" & Me.txt_rackID.Value
dsh.UsedRange.AutoFilter 6, ">0"
dsh.UsedRange.AutoFilter 4, "=" & Me.txt_racklvl.Value
[COLOR=rgb(226, 80, 65)][B]dsh.UsedRange.AutoFilter 5 ="A"
'''' represents box ID''''''[/B][/COLOR]

sh.UsedRange.Clear

dsh.UsedRange.Copy

sh.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats

dsh.AutoFilterMode = False

''''''display data in box'''''''

Dim lr As Long

lr = Application.WorksheetFunction.CountA(sh.Range("A:A"))
If lr = 1 Then lr = 2

[B][COLOR=rgb(226, 80, 65)]With Me.ListBox2[/COLOR][/B]
.ColumnCount = 7
.ColumnHeads = True
.ColumnWidths = "0,120,80,80,80,80,80"
.RowSource = sh.Name & "!A2:H" & lr

Is there a way to generate a loop which will cycle through changing the Me.listbox(No) & Letter (As highlighted in red), automatically?
This will just save me copying this code for each list box, and minimising the length of the macro.

 

[senorcalidad]

Minor errors in above. TankID should be rackId in

If Me.txt_tankID.Value = "" Then
MsgBox "Please enter Tank ID"
End If

Formatting - lines I would like to automate changing as prefixed with [COLOR]