Option Explicit
Dim myFormat(1) As String
Dim Arr As Variant
'Public Arr As Variant '// Only declare something public if it is used in more modules or forms. _
// Even then don't declare it public in a form, as the form needs to be created if it is used in another module. _
// So publics are declared in a standard module.
Private Sub cbxShtName_Change()
Dim dicDates As Object
Dim lR As Long, UB1 As Long
With cbxShtName
' combined tests for Exit
If .Value = "" Or .ListIndex = -1 Then Exit Sub
With Sheets(.Value).Cells(1).CurrentRegion
' Set rng = .Offset(1).Resize(.Rows.Count - 1) 'leave out the step with the range. Just set the Arr array to the range
Arr = .Value
' Arr now contains the complete data set for this sheet
' Arr = .Cells(1).CurrentRegion '.Value
End With
'get number of rows in array
UB1 = UBound(Arr, 1)
'Clear cbxDate
With cbxDate
.Clear
.Value = ""
End With
'// uncomment next line to clear the search box every time the sheet gets changed
' tbxSearch = "" 'added- clear search box and CB2
' Clear the ListBox and repopulate
ListboxResultPopulate
' get ready to populate CB2
' Dim SH As Worksheet, dic As Object, i As Long
' Set SH = Worksheets(cbxShtName.Value)
Set dicDates = CreateObject("Scripting.Dictionary")
' populate CB2
' With SH
' For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
' dic(Format(CDate(.Range("A" & i).Value), "mmm-yyyy")) = Empty
' Next i
' End With
For lR = 2 To UB1
dicDates(Format(CDate(Arr(lR, 1)), "mmm-yyyy")) = Empty
Next lR
cbxDate.List = dicDates.Keys
End With
End Sub
Private Sub ListboxResultPopulate()
Dim lR As Long, lC As Long, UB1 As Long, UB2 As Long, n As Long
Dim bDt As Boolean, bSrch As Boolean
Dim sFilter As String
bDt = Len(cbxDate.Value)
bSrch = Len(tbxSearch.Value)
UB1 = UBound(Arr, 1)
UB2 = UBound(Arr, 2)
' Clear the ListBox and repopulate using Arr and the date & search filters
With Me.lbxResult
If .ListCount > 0 Then
.RowSource = ""
.Clear
End If
If bDt Then sFilter = cbxDate.Value 'a little bit more efficient within loops
'now add rows depending on date filter (code based on your FilterByDate sub)
For lR = 2 To UB1
If bDt Then
If Format(CDate(Arr(lR, 1)), "mmm-yyyy") Like sFilter Then
AddLine n, lR
n = n + 1
End If
Else
AddLine n, lR
' .AddItem
' For lC = 1 To UB2
' .List(n, lC - 1) = Arr(lR, lC)
' Next lC
' .List(n, 0) = Format(CDate(Arr(lR, 1)), "dd/mm/yyyy")
' .List(n, 7) = Format$(.List(n, 7), myFormat(0))
' .List(n, 8) = Format$(.List(n, 8), myFormat(1))
' .List(n, 9) = Format$(.List(n, 9), myFormat(1))
n = n + 1
End If
Next lR
'Next check for Search and remove rows from Listbox
If bSrch Then
sFilter = tbxSearch
' remove items backwards!!
For n = .ListCount - 1 To 0 Step -1
If Not (.List(n, 3) Like "*" & sFilter & "*") Then
.RemoveItem (n)
End If
Next n
End If
End With
'//old code
' lbxResult.RowSource = ""
' lbxResult.Clear
' lbxResult.RowSource = "'" & Sheets(.Value).Name & "'!" & Sheets(.Value).Range("A1", Sheets(.Value).Range("H" & Rows.Count).End(3)).Address
' tbxSearch = "" 'added- clear search box and CB2
' cbxDate.Value = ""
' ' rewrite array
' Arr = lbxResult.List
'//
End Sub
Private Sub AddLine(lIndex As Long, lR As Long)
Dim UB2 As Long, lC As Long
UB2 = UBound(Arr, 2)
With lbxResult
.AddItem
For lC = 1 To UB2
.List(lIndex, lC - 1) = Arr(lR, lC)
'// avoid as much as possible within loops. The following can be done outside the inner loop
' ' overwrite the date if appropriate
' If ii = 0 Then .List(lIndex, 0) = Format(CDate(Arr(i, 0)), "dd/mm/yyyy")
Next lC
.List(lIndex, 0) = Format(CDate(Arr(lR, 1)), "dd/mm/yyyy")
.List(lIndex, 7) = Format$(.List(lIndex, 7), myFormat(0))
.List(lIndex, 8) = Format$(.List(lIndex, 8), myFormat(1))
.List(lIndex, 9) = Format$(.List(lIndex, 9), myFormat(1))
End With
End Sub
Private Sub cbxDate_Change()
' If cbxDate.Value = "" Then Exit Sub
If cbxDate.ListIndex = -1 Then Exit Sub
ListboxResultPopulate
' ' clear text search
' tbxSearch.Value = ""
'
' With lbxResult
' .RowSource = ""
' .Clear
' .RowSource = "'" & Sheets(cbxShtName.Value).Name & "'!" & Sheets(cbxShtName.Value).Range("A1", Sheets(cbxShtName.Value).Range("H" & Rows.Count).End(3)).Address
' Arr = .List
' End With
' FilterByDate
End Sub
Private Sub tbxSearch_Change()
ListboxResultPopulate
' Call FilterData
End Sub
Private Sub UserForm_Initialize()
'// in the Initialize sub only set up the form. Don't start filling ot controls. Do that in the Activate sub
Dim rngDB As Range, rng As Range
Dim sWidth As String
Dim vR() As Variant
Dim n As Integer
Dim myMax As Single
Dim SH As Worksheet
' populate cbxShtName list eith sheet names
For Each SH In ThisWorkbook.Worksheets
cbxShtName.AddItem SH.Name
Next SH
Set rngDB = Range("A1:J20")
For Each rng In rngDB
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = rng.EntireColumn.Width
Next rng
'// uncomment next lines to have listbox display each column at max width. _
With it commented out, the width will be the same as on the sheet
' myMax = WorksheetFunction.Max(vR)
' For i = 1 To n
' vR(i) = myMax
' Next i
'//
With Sheets("purchase").Cells(1).CurrentRegion
myFormat(0) = .Cells(2, 8).NumberFormatLocal
myFormat(1) = .Cells(2, 9).NumberFormatLocal
'the following will be done in the cbxShtName_Change sub
' Set rng = .Offset(1).Resize(.Rows.Count - 1)
' Arr = .Cells(1).CurrentRegion '.Value
End With
sWidth = Join(vR, ";")
'Debug.Print sWidth
With lbxResult
.ColumnCount = 10
.ColumnWidths = sWidth '<~~ 63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63;63
''''' .List = Arr 'rng.Value
.BorderStyle = fmBorderStyleSingle
''''' For lindex = 0 To .ListCount - 1
''''' .List(lindex, 0) = (Format((.List(lindex, 0)), "dd/mm/yyyy")) ' BL = dates
''''' ' .List(lindex, 0) = lindex + 1
'''''
''''' .List(lindex, 7) = Format$(.List(lindex, 7), myFormat(0))
''''' .List(lindex, 8) = Format$(.List(lindex, 8), myFormat(1))
''''' .List(lindex, 9) = Format$(.List(lindex, 9), myFormat(1))
''''' Next
' Arr = .List
'<--- this line
End With
End Sub
Private Sub UserForm_Activate()
'// No need toduplicate the combobox fill code. Just set the listindex to the first item, then the change code will run \\
cbxShtName.ListIndex = 0
'Dim i As Long, dic As Object
' Dim SH As Worksheet
' Set SH = sheet1
' Set dic = CreateObject("Scripting.Dictionary")
'
' For i = 2 To SH.Range("A" & Rows.Count).End(xlUp).Row
' dic(Format(CDate(SH.Range("A" & i).Value), "mmm-yyyy")) = Empty
' Next
' cbxDate.List = dic.Keys
' ' set cbxShtName to the matching value
' cbxShtName.Value = SH.Name
'set the first sheet in the controlbox. This will call the _
cbxShtName_Change sub, where the array Arr will be filled
End Sub
'Sub FilterData()
'
' Dim i As Long, ii As Long, n As Long
' 'Me.lbxResult.List = Arr
' If Me.tbxSearch = "" Then Exit Sub
' With Me.lbxResult
' If .ListCount > 0 Then ' ## added
' .RowSource = "" ' ## added
' .Clear
' End If
' For i = 0 To UBound(Arr, 1)
' If UCase$(Arr(i, 3)) Like "*" & UCase$(Me.tbxSearch) & "*" Then ' ## changed
' .AddItem
' .List(n, 0) = n + 1
' For ii = 1 To UBound(Arr, 2)
' .List(n, ii) = Arr(i, ii)
' Next
' n = n + 1
' End If
' Next
' End With
'End Sub
'Sub FilterByDate() '// now included in ListboxResultPopulate()
' Dim i As Long, ii As Long, n As Long
'
' If Me.cbxDate = "" Then
' UserForm_Activate
' Exit Sub
' End If
' With Me.lbxResult
'
' If .ListCount > 0 Then
' .RowSource = ""
' .Clear
' End If
'
'
' ' filter data
' For i = 1 To UBound(Arr, 1)
' ' filter array by chosen date
' If Format(CDate(Arr(i, 0)), "mmm-yyyy") = Me.cbxDate.Value Then
' .AddItem
' For ii = 0 To UBound(Arr, 2)
' .List(n, ii) = Arr(i, ii)
' ' overwrite the date if appropriate
' If ii = 0 Then .List(n, 0) = Format(CDate(Arr(i, 0)), "dd/mm/yyyy")
' Next ii
' n = n + 1
' End If
' Next
' End With
'End Sub