modifying code by add textboxes on userform to search between two dates

T

tubrak

Board Regular
Joined
May 30, 2021
Messages
218
Office Version
  1. 2019
Platform
  1. Windows
I have code got by Dante amore's assistance .

so the code will populate the whole data in listbox and when I fill name in textbox name (MY_Text) will add column in listbox to calculate the balance

by summing and subtracting amongst the rows in listbox between columns E,F and will calculate into textboxes names( Deb_txt, Cre_txt) by summing based on columns E,F and textbox name (Bal_txt.Value) =Deb_txt-Cre_txt
now I want adding two textboxs names (textbox1,textbox2) to search for date from and to
whether I write the name or not inMY_Text
if I write name and fill two dates then will show data and calculate within two dates , if I don't write name but write two dates then will populate based on two dates .
this is the orginal thread to understand more .
Insert column in listbox & populate values in textboxes
first when write name will populate data and calculate the balance
TU1.JPG



second when write two dates with names
TU2.JPG


third when just search two dates
TUB3.JPG


the wholes codes
VBA Code: 
'dante
'tubrak
'https://www.mrexcel.com/board/threads/insert-column-in-listbox-populate-values-in-textboxes.1183845/
Private Sub CommandButton4_Click()
Dim sh As Worksheet
  Dim r As Integer, t As Integer
  Dim dbt As Double, cdt As Double, blc As Double
  
  Set sh = ActiveSheet
  With MY_List
    .Clear
    For r = 1 To sh.Cells(Rows.Count, "C").End(xlUp).Row
      If LCase(sh.Cells(r, "C")) Like "*" & LCase(MY_Text.Text) & "*" Or sh.Cells(r, "C") = "Name" Then
        .AddItem
        .List(t, 0) = sh.Cells(r, "A")
        .List(t, 1) = Format(sh.Cells(r, "B"), "yyyy/mm/dd")
        .List(t, 2) = sh.Cells(r, "C")
        .List(t, 3) = sh.Cells(r, "D")
        .List(t, 4) = Format(sh.Cells(r, "E"), "#,##0.00")
        .List(t, 5) = Format(sh.Cells(r, "F"), "#,##0.00")
        If r = 1 Then
          If MY_Text.Value <> "" Then .List(t, 6) = "BALANCE"
        Else
          dbt = dbt + sh.Cells(r, "E")
          cdt = cdt + sh.Cells(r, "F")
          blc = blc + sh.Cells(r, "E") - sh.Cells(r, "F")
          If MY_Text.Value <> "" Then .List(t, 6) = Format(blc, "#,##0.00")
        End If
        t = t + 1
      End If
    Next
    Deb_txt.Value = Format(dbt, "#,##0.00")
    Cre_txt.Value = Format(cdt, "#,##0.00")
    Bal_txt.Value = Format(blc, "#,##0.00")
  End With
End Sub

Private Sub MY_Text_Change()
Dim sh As Worksheet
  Dim r As Integer, t As Integer
  Dim dbt As Double, cdt As Double, blc As Double
  
  Set sh = ActiveSheet
  With MY_List
    .Clear
    For r = 1 To sh.Cells(Rows.Count, "C").End(xlUp).Row
      If LCase(sh.Cells(r, "C")) Like "*" & LCase(MY_Text.Text) & "*" Or sh.Cells(r, "C") = "Name" Then
        .AddItem
        .List(t, 0) = sh.Cells(r, "A")
        .List(t, 1) = Format(sh.Cells(r, "B"), "yyyy/mm/dd")
        .List(t, 2) = sh.Cells(r, "C")
        .List(t, 3) = sh.Cells(r, "D")
        .List(t, 4) = Format(sh.Cells(r, "E"), "#,##0.00")
        .List(t, 5) = Format(sh.Cells(r, "F"), "#,##0.00")
        If r = 1 Then
          If MY_Text.Value <> "" Then .List(t, 6) = "BALANCE"
        Else
          dbt = dbt + sh.Cells(r, "E")
          cdt = cdt + sh.Cells(r, "F")
          blc = blc + sh.Cells(r, "E") - sh.Cells(r, "F")
          If MY_Text.Value <> "" Then .List(t, 6) = Format(blc, "#,##0.00")
        End If
        t = t + 1
      End If
    Next
    Deb_txt.Value = Format(dbt, "#,##0.00")
    Cre_txt.Value = Format(cdt, "#,##0.00")
    Bal_txt.Value = Format(blc, "#,##0.00")
  End With
End Sub

Private Sub UserForm_Initialize()
  Dim LastRow As Long
  LastRow = Range("A" & Rows.Count).End(xlUp).Row
  With MY_List
    .ColumnCount = 7
    .ColumnWidths = "50;80,80;80;80"
    Call CommandButton1_Click
  End With
End Sub

Private Sub MY_List_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = vbKeyEscape Then
    Me.MY_Text = ""
    Me.MY_Text.SetFocus
  ElseIf KeyCode = vbKeyF12 Then
    Unload Me
  End If
End Sub



I hope somebody can modify.
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
tubrak said:
if I write name then
Click to expand...
show data
tubrak said:
if I write name and fill two dates then
Click to expand...
show data
tubrak said:
if I don't write name but write two dates then
Click to expand...
show data

If you are going to filter by date, you must write the 2 dates.

Change the name "Sheet1" in the macro to the name of the sheet where you have your data.

Replace all your code with the following.
VBA Code: 
Option Explicit

Dim sh As Worksheet
Dim a As Variant

Private Sub CommandButton4_Click()
  Dim i As Long, t As Long
  Dim dbt As Double, cdt As Double, blc As Double
  Dim n As Double, m As Double
  Dim tbx1 As String, tbx2 As String, tbxm As String
  
  With MY_List
    .Clear
    For i = 1 To UBound(a, 1)
      tbxm = MY_Text.Value
      With TextBox1
        If Len(TextBox1.Value) = 10 And IsDate(TextBox1.Value) And _
           Len(TextBox2.Value) = 10 And IsDate(TextBox2.Value) Then
          tbx1 = TextBox1.Value
          tbx2 = TextBox2.Value
        Else
          tbx1 = a(i, 2)
          tbx2 = a(i, 2)
        End If
      End With
      
      If i = 1 Then
        .AddItem
        .List(t, 0) = a(i, 1)
        .List(t, 1) = a(i, 2)
        .List(t, 2) = a(i, 3)
        .List(t, 3) = a(i, 4)
        .List(t, 4) = a(i, 5)
        .List(t, 5) = a(i, 6)
        t = t + 1
      ElseIf LCase(a(i, 3)) Like "*" & LCase(tbxm) & "*" And _
        a(i, 2) >= CDate(tbx1) And a(i, 2) <= CDate(tbx2) Then
        .AddItem
        .List(t, 0) = a(i, 1)
        .List(t, 1) = Format(a(i, 2), "yyyy/mm/dd")
        .List(t, 2) = a(i, 3)
        .List(t, 3) = a(i, 4)
        .List(t, 4) = Format(a(i, 5), "#,##0.00")
        .List(t, 5) = Format(a(i, 6), "#,##0.00")
        If i = 1 Then
          If MY_Text.Value <> "" Then .List(t, 6) = "BALANCE"
        Else
          If IsNull(a(i, 5)) Then n = 0 Else n = a(i, 5)
          dbt = dbt + n
          If IsNull(a(i, 6)) Then m = 0 Else m = a(i, 6)
          cdt = cdt + m
          blc = blc + n - m
          If MY_Text.Value <> "" Then .List(t, 6) = Format(blc, "#,##0.00")
        End If
        t = t + 1
      End If
    Next
    Deb_txt.Value = Format(dbt, "#,##0.00")
    Cre_txt.Value = Format(cdt, "#,##0.00")
    Bal_txt.Value = Format(blc, "#,##0.00")
  End With
End Sub

Private Sub MY_Text_Change()
  Call CommandButton4_Click
End Sub

Private Sub TextBox1_Change()
'date From
  Call CommandButton4_Click
End Sub

Private Sub TextBox2_Change()
'date To
  Call CommandButton4_Click
End Sub

Private Sub UserForm_Initialize()
  Dim LastRow As Long
  Set sh = ActiveSheet
  a = sh.Range("A1:F" & sh.Range("A" & Rows.Count).End(xlUp)).Value
  With MY_List
    .ColumnCount = 7
    .ColumnWidths = "20;50;100;100;70;70;70"
    Call CommandButton4_Click
  End With
End Sub

Private Sub MY_List_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = vbKeyEscape Then
    Me.MY_Text = ""
    Me.MY_Text.SetFocus
  ElseIf KeyCode = vbKeyF12 Then
    Unload Me
  End If
End Sub
 
Upvote 0
Hi Dante (nice to see you again):)
it's perfect updating (y)
just I want fixing re-autonumbering (1,2,3..) in first column when search for data whether I write name and fill two dates or just write two dates.
can you fix it please?
 
Upvote 0
tubrak said:
just I want fixing re-autonumbering (1,2,3..) in first column when search for data whether I write name and fill two dates or just write two dates.
can you fix it please?
Click to expand...
Try:


VBA Code: 
Option Explicit

Dim sh As Worksheet
Dim a As Variant

Private Sub CommandButton4_Click()
  Dim i As Long, t As Long
  Dim dbt As Double, cdt As Double, blc As Double
  Dim n As Double, m As Double
  Dim tbx1 As String, tbx2 As String, tbxm As String
  
  With MY_List
    .Clear
    For i = 1 To UBound(a, 1)
      tbxm = MY_Text.Value
      With TextBox1
        If Len(TextBox1.Value) = 10 And IsDate(TextBox1.Value) And _
           Len(TextBox2.Value) = 10 And IsDate(TextBox2.Value) Then
          tbx1 = TextBox1.Value
          tbx2 = TextBox2.Value
        Else
          tbx1 = a(i, 2)
          tbx2 = a(i, 2)
        End If
      End With
      
      If i = 1 Then
        .AddItem
        .List(t, 0) = a(i, 1)
        .List(t, 1) = a(i, 2)
        .List(t, 2) = a(i, 3)
        .List(t, 3) = a(i, 4)
        .List(t, 4) = a(i, 5)
        .List(t, 5) = a(i, 6)
        If MY_Text.Value <> "" Then .List(t, 6) = "BALANCE"
        t = t + 1
      ElseIf LCase(a(i, 3)) Like "*" & LCase(tbxm) & "*" And _
        a(i, 2) >= CDate(tbx1) And a(i, 2) <= CDate(tbx2) Then
        .AddItem
        .List(t, 0) = t 'a(i, 1)
        .List(t, 1) = Format(a(i, 2), "yyyy/mm/dd")
        .List(t, 2) = a(i, 3)
        .List(t, 3) = a(i, 4)
        .List(t, 4) = Format(a(i, 5), "#,##0.00")
        .List(t, 5) = Format(a(i, 6), "#,##0.00")
        
        If IsNull(a(i, 5)) Then n = 0 Else n = a(i, 5)
        dbt = dbt + n
        If IsNull(a(i, 6)) Then m = 0 Else m = a(i, 6)
        cdt = cdt + m
        blc = blc + n - m
        If MY_Text.Value <> "" Then .List(t, 6) = Format(blc, "#,##0.00")
        
        t = t + 1
      End If
    Next
    Deb_txt.Value = Format(dbt, "#,##0.00")
    Cre_txt.Value = Format(cdt, "#,##0.00")
    Bal_txt.Value = Format(blc, "#,##0.00")
  End With
End Sub

Private Sub MY_Text_Change()
  Call CommandButton4_Click
End Sub

Private Sub TextBox1_Change()
'date From
  Call CommandButton4_Click
End Sub

Private Sub TextBox2_Change()
'date To
  Call CommandButton4_Click
End Sub

Private Sub UserForm_Initialize()
  Dim LastRow As Long
  Set sh = ActiveSheet
  a = sh.Range("A1:F" & sh.Range("A" & Rows.Count).End(xlUp)).Value
  With MY_List
    .ColumnCount = 7
    .ColumnWidths = "20;50;100;100;70;70;70"
    Call CommandButton4_Click
  End With
End Sub

Private Sub MY_List_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = vbKeyEscape Then
    Me.MY_Text = ""
    Me.MY_Text.SetFocus
  ElseIf KeyCode = vbKeyF12 Then
    Unload Me
  End If
End Sub
 
Upvote 0
Solution
awesom !
just guestion about this line
VBA Code: 
    .ColumnWidths = "20;50;100;100;70;70;70"
can autofit the columns in listbox as the sheet ?
becuase I find difficultly to make it manually by adding values for this line .
thanks again
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
modifying code to implement for two optionbuttons on userform and two sheets
2
Replies
10
Views
755
dmt32
D
P
  • Question Question
ListBox Click to textbox & delete row
Replies
0
Views
607
pure vito
P
M
  • Solved
Display textbox from listbox - getting 381 error
Replies
4
Views
644
maiatanaka
M
A
  • Question Question
possible calculation in listbox for debit , credit when search based on textbox ?
Replies
0
Views
434
abdelfattah
A
X
  • Solved
It didn't change the forecolor of the textbox
Replies
4
Views
525
Fluff
Fluff

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top