Option Explicit
Const cDataSheetName As String = "Sheet1"
Const cTemporarySheetName As String = "Sheet2"
Public dataSheet As Worksheet
Public temporarySheet As Worksheet
Public lastDataRow As Long
Public firstFilteredCopyRow As Long, lastFilteredCopyRow As Long
Private Sub UserForm_Initialize()
'Copy data to temporary sheet where it will provide a list of unique Estimators for the cboEstimators combobox and
'filtered data for the lstEstimates listbox
Dim lastRowColA As Long
Set dataSheet = Sheets(cDataSheetName)
Set temporarySheet = Sheets(cTemporarySheetName)
firstFilteredCopyRow = 0
'Determine the last row containing data
With dataSheet
lastDataRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With temporarySheet
'Clear temporary data
.AutoFilterMode = False
.Cells.ClearContents
'Filter unique Estimators on data sheet column F and copy list to temporary sheet column A
dataSheet.Range("F1:F" & lastDataRow).EntireColumn.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A1"), Unique:=True
'Get the number of unique Estimators and populate the cboEstimator combobox. The combobox's RowSource
'starts at A2 so that it doesn't include the column header
lastRowColA = .Cells(.Rows.Count, "A").End(xlUp).Row
cboEstimator.RowSource = temporarySheet.Name & "!" & .Range("A2:F" & lastRowColA).Address
'Copy data sheet columns A:H to temporary sheet columns B:I where it will be filtered to provide values for
'the lstEstimators listbox
dataSheet.Range("A1:H" & lastDataRow).Copy Destination:=.Range("B1")
End With
End Sub
Private Sub btnShowEstimates_Click()
If cboEstimator.ListIndex >= 0 Then
Fill_Estimates_ListBox (cboEstimator.Value)
End If
End Sub
Private Sub Fill_Estimates_ListBox(sEstimator As String)
'Populate the Estimates listbox with records matching the specified Estimator. This is done by filtering data on
'the temporary sheet and copying the visible rows so that a contiguous set of rows is available for
'the listbox's RowSource property
Dim filterRange As Range
Dim lastRow As Long
Dim visibleRows As Long
Dim filteredCopyRowSource As String
'Clear the listbox
lstEstimates.RowSource = ""
lstEstimates.Clear
'Clear the copy of the filtered data that was last used to populate the listbox
If firstFilteredCopyRow <> 0 Then
temporarySheet.Rows(firstFilteredCopyRow & ":" & lastFilteredCopyRow).ClearContents
End If
With temporarySheet
.AutoFilterMode = False
'Create an autofilter of columns B:I filtered on the 6th column (column G) matching the specified Estimator
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set filterRange = .Range("B1:I" & lastRow)
filterRange.AutoFilter Field:=6, Criteria1:=sEstimator
'Create a contiguous copy of the visible rows (including the column headers row) starting 2 rows below the temporary data
visibleRows = filterRange.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
firstFilteredCopyRow = lastRow + 2
lastFilteredCopyRow = firstFilteredCopyRow + visibleRows - 1
With .AutoFilter.Range
.Resize(.Rows.Count).Copy (.Cells(firstFilteredCopyRow, 1))
End With
'Construct listbox's RowSource string. This starts at the first row of actual data so that the listbox automatically
'picks up the column headers from the row above
filteredCopyRowSource = .Name & "!" & _
.Range("B" & firstFilteredCopyRow + 1 & _
":I" & lastFilteredCopyRow).Address
End With
'Put the data in the listbox. Its 6th column (Estimator) is hidden by setting that column's width to 0
lstEstimates.ColumnCount = 8
lstEstimates.ColumnWidths = "50;50;50;50;50;0;50;50"
lstEstimates.RowSource = filteredCopyRowSource
End Sub
Private Sub lstEstimates_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'User has double-clicked a row in the Estimates listbox. Populate labels on the userform with values from the listbox row
Dim i As Long
If Not Cancel Then
With lstEstimates
i = .ListIndex
lblAsset.Caption = .List(i, 0)
lblProjectNo.Caption = .List(i, 1)
lblProjectName.Caption = .List(i, 2)
lblEstimateNo.Caption = .List(i, 3)
lblEstimateName.Caption = .List(i, 4)
lblEstimator.Caption = .List(i, 5)
lblValidatedBy.Caption = .List(i, 6)
lblDateArchived.Caption = Format(.List(i, 7), "dd/mm/yyyy")
End With
End If
End Sub