Dim c As Variant
Private Sub Textbox1_Change()
Call FilterData
End Sub
Private Sub Textbox2_Change()
Call FilterData
End Sub
Private Sub FilterData()
Dim tb1 As Date, tb2 As Date
Dim i As Long, j As Long, k As Long, y As Long, nRow As Long
Dim b As Variant, d As Variant, ky As Variant
Dim dic As Object
Dim t1 As Double, t2 As Double, t3 As Double, t4 As Double
If Len(TextBox1.Value) <> 10 And TextBox1.Value <> "" Then Exit Sub
If Len(TextBox2.Value) <> 10 And TextBox2.Value <> "" Then Exit Sub
If Not IsDate(TextBox1.Value) And TextBox1.Value <> "" Then Exit Sub
If Not IsDate(TextBox2.Value) And TextBox2.Value <> "" Then Exit Sub
If TextBox1.Value <> "" And TextBox2.Value = "" Then Exit Sub
If TextBox1.Value = "" And TextBox2.Value <> "" Then Exit Sub
If TextBox1.Value <> "" And TextBox2.Value <> "" Then
If CDate(TextBox2.Value) < CDate(TextBox1.Value) Then
MsgBox "The end date is less than the start date"
Exit Sub
End If
End If
Set dic = CreateObject("Scripting.Dictionary")
ListBox1.Clear
ReDim b(1 To UBound(c, 1), 1 To UBound(c, 2))
ReDim d(1 To UBound(c, 1), 1 To 8)
d(1, 1) = "ITEM"
d(1, 2) = "BATCH"
d(1, 3) = "ID"
d(1, 4) = "BBR"
d(1, 5) = "BMTR"
d(1, 6) = "BMTR"
d(1, 7) = "VSR"
d(1, 8) = "TOTAL"
y = 1
For i = 2 To UBound(c)
If TextBox1.Value = "" Then tb1 = CDate(c(i, 1)) Else tb1 = CDate(TextBox1.Value)
If TextBox2.Value = "" Then tb2 = CDate(c(i, 1)) Else tb2 = CDate(TextBox2.Value)
If CDate(c(i, 1)) >= tb1 And CDate(c(i, 1)) <= tb2 Then
ky = c(i, 3)
If Not dic.exists(ky) Then
y = y + 1
dic(ky) = y
End If
nRow = dic(ky)
d(nRow, 1) = nRow - 1
d(nRow, 2) = c(i, 2)
d(nRow, 3) = c(i, 3)
d(nRow, 4) = d(nRow, 4) + c(i, 4)
d(nRow, 5) = d(nRow, 5) + c(i, 5)
d(nRow, 6) = d(nRow, 6) + c(i, 6)
d(nRow, 7) = d(nRow, 7) + c(i, 7)
d(nRow, 8) = d(nRow, 4) - d(nRow, 5) + d(nRow, 6) - d(nRow, 7)
t1 = t1 + c(i, 4)
t2 = t2 + c(i, 5)
t3 = t3 + c(i, 6)
t4 = t4 + c(i, 7)
End If
Next
For i = 2 To dic.Count + 1
d(i, 4) = Format(d(i, 4), "#,##0.00;;-")
d(i, 5) = Format(d(i, 5), "#,##0.00;;-")
d(i, 6) = Format(d(i, 6), "#,##0.00;;-")
d(i, 7) = Format(d(i, 7), "#,##0.00;;-")
d(i, 8) = Format(d(i, 8), "#,##0.00;;-")
Next
d(dic.Count + 2, 1) = "TOTAL"
d(dic.Count + 2, 8) = Format(t1 - t2 + t3 - t4, "#,##0.00;;-")
ListBox1.List = d
End Sub
Private Sub UserForm_Activate()
Dim i As Long, nMax As Long, k As Long
Dim sh As Worksheet
Dim arr As Variant, itm As Variant
Dim a As Variant, b As Variant
arr = Array("BBR", "BMTR", "VSR", "STR")
For Each itm In arr
Set sh = Sheets(itm)
nMax = nMax + sh.Range("A" & Rows.Count).End(3).Row - 1
Next
ReDim b(1 To nMax, 1 To 8)
For Each itm In arr
Set sh = Sheets(itm)
a = sh.Range("A2", sh.Range("G" & Rows.Count).End(3)).Value
For i = 1 To UBound(a, 1)
k = k + 1
b(k, 1) = a(i, 1)
b(k, 2) = a(i, 2)
b(k, 3) = a(i, 4)
Select Case itm
Case "BBR": b(k, 4) = a(i, 7)
Case "BMTR": b(k, 5) = a(i, 7)
Case "VSR": b(k, 6) = a(i, 7)
Case "STR": b(k, 7) = a(i, 7)
End Select
Next
Next
Application.ScreenUpdating = False
With Sheets("BBR")
.Range("AA:AG").Clear
.Range("AA2").Resize(k, 7).Value = b
.Range("AA1:AG" & UBound(b) + 1).Sort .Range("AB1"), xlAscending, Header:=xlYes
c = .Range("AA1:AG" & UBound(b) + 1).Value
.Range("AA:AG").ClearContents
End With
Application.ScreenUpdating = True
ListBox1.ColumnCount = 8
Call FilterData
End Sub