Selected Answer
Hi Tamer
Revision #4 (Replacement Answer) 01 September 2025
On checking your code again, I realised that the problem is not with Private Sub LB2() -which populates ListBox 2 of UserForm1) but with the procedure GetData()....
In the attached revised file, I've modified the code as follows (with comments to say broadly what happens and where the error was / how I corrected it). Please see the changes in bold:
Private
Dim a, i As Long, ii As Long, rng As Range, x, n As Long, myList, temp
Dim myName As String, Dates(1 To 2), flg As Boolean
' new loop counter for CB1=all
Dim p As Long
For i = 4 To 6
Me("textbox" & i) = 0
Next
myName = Me.ComboBox1.Value
For i = 1 To 2
If Me("textbox" & i) <> "" Then
If Me("TextBox" & i) Like "##/##/####" Then
x = Split(Me("textbox" & i), "/")
Dates(i) = DateSerial(x(2), x(1), x(0))
Else
MsgBox "Date in " & IIf(i = 1, "DateFrom", "DateTo") & " is not valid": Exit Sub
End If
End If
Next
Set rng = Sheets("balance first of duration").Cells(1).CurrentRegion
a = Sheets("sheet1").Cells(1).CurrentRegion.Value
ReDim myList(1 To UBound(a, 1) + 1)
' this section checks "balance first...."
If (myName <> "") * (myName <> "all") Then
x = Application.Match(myName, rng.Columns(2), 0)
If IsNumeric(x) Then
Me.TextBox3 = rng(x, 4)
temp = Evaluate("{""" & Format$(rng(x, 1), "yyyy/m/d") & """,""" & _
rng(x, 2) & """,""" & rng(x, 3) & ""","""","""","""",""" & rng(x, 4) & """}")
n = n + 1: myList(n) = temp
Else
Me.TextBox3 = 0
End If
' ### but this portion failed to collect the balance details when "all" (so it's commented out)
' Else
'
' Me.TextBox3 = Application.Sum(rng.Columns(4))
' temp = Evaluate("{""" & Format$(rng(2, 1), "yyyy/m/d") & ""","""","""","""","""","""",""" & _
' Application.Sum(rng.Columns(4)) & """}")
' n = n + 1: myList(n) = temp
' ### replaced with this portion...
Else
' gather all balances
For p = 2 To rng.Rows.Count
Me.TextBox3 = rng(p, 4)
temp = Evaluate("{""" & Format$(rng(p, 1), "yyyy/m/d") & """,""" & _
rng(p, 2) & """,""" & rng(p, 3) & ""","""","""","""",""" & rng(p, 4) & """}")
n = n + 1: myList(n) = temp
Next p
End If
' this checks then entries in "sheet1"
For i = 2 To UBound(a, 1)
If (myName <> "") * (myName <> "all") Then
flg = a(i, 2) = myName
ElseIf (myName = "") + (myName = "all") Then
flg = True
End If
If IsDate(Dates(1)) Then flg = flg * (a(i, 1) >= Dates(1)) Else flg = flg * True
If IsDate(Dates(2)) Then flg = flg * (a(i, 1) <= Dates(2)) Else flg = flg * True
If flg Then
n = n + 1
x = Application.Index(a, i, Array(1, 2, 3, 4, 5, 6, 6))
Me.TextBox4 = Val(Me.TextBox4) + x(5)
Me.TextBox5 = Val(Me.TextBox5) + x(6)
If n > 1 Then
temp = myList(n - 1)
x(UBound(x)) = temp(UBound(temp))
Else
x(UBound(x)) = 0
End If
x(UBound(x)) = x(UBound(x)) + x(UBound(x) - 2) - x(UBound(x) - 1)
ReDim Preserve myList(1 To 51)
myList(n) = x
End If
Next i
Me.ListBox1.Clear
If n = 0 Then Exit Sub
Me.ListBox1.ColumnCount = 7
ReDim Preserve myList(1 To n)
Me.TextBox6 = Val(Me.TextBox3) + Val(Me.TextBox4) - Val(Me.TextBox5)
If n = 1 Then
Me.ListBox1.Column = myList(n)
Else
Me.ListBox1.List = Application.Index(myList, 0, 0)
End If
With Sheets("result1")
.[n3] = Me.ComboBox1
.[o4:p4] = Array(Dates(1), Dates(2))
End With
With ListBox1
.ColumnCount = 7 '<---- Change to 18??????
.ColumnWidths = "65;60;60;50;50;50;50" ' modified
End With
LB2
End Sub
Revision #5 03 September 2025
A further revision was needed to Sub LB2 to correct the output in ListBox2, this time reversing changes I made earlier- see comments and items in bold below
Private Sub LB2()
sn = ListBox1.List
Set dic = CreateObject("scripting.dictionary")
With ListBox1
' corrected- was revised to: For i = 1 To .ListCount
For i = 0 To .ListCount - 1
' corrected- was revised to: x0 = dic.Item(.List(i - 1, 1))
x0 = dic.Item(.List(i, 1))
Next
End With
Now the code gives the outcomes shown on your worksheet result1 (by clicking the button "Launch form" and picking "all" under the NAMES dropdown) and individual name selections give correct balances.
Revision #6 04 September 2025
The solution above gives correct results in ListBox2 but confusing (and incorrect) balances in ListBox1. In the SECOND file attached, the code has a quick fix to suppress line balances in ListBox1, see changes in bold to this portion of Sub GetData():.
<< existing code omitted>>
If IsDate(Dates(1)) Then flg = flg * (a(i, 1) >= Dates(1)) Else flg = flg * True
If IsDate(Dates(2)) Then flg = flg * (a(i, 1) <= Dates(2)) Else flg = flg * True
If flg Then
n = n + 1
x = Application.Index(a, i, Array(1, 2, 3, 4, 5, 6, 6))
Me.TextBox4 = Val(Me.TextBox4) + x(5)
Me.TextBox5 = Val(Me.TextBox5) + x(6)
' to suppress line balances, skip this...
' If n > 1 Then
' temp = myList(n - 1)
' x(UBound(x)) = temp(UBound(temp))
' Else
' x(UBound(x)) = 0
' End If
' x(UBound(x)) = x(UBound(x)) + x(UBound(x) - 2) - x(UBound(x) - 1)
'... but use this
x(UBound(x)) = ""
ReDim Preserve myList(1 To 51)
myList(n) = x
End If
Next i
<< existing code omitted>>
Hope this solves your problem. If so, please be sure to mark this Answer as Selected.
