make bigger or smaller height the listbox & userform based on populated data in listbox

Mussa

Board Regular
Joined
Jul 12, 2021
Messages
164
Office Version
  1. 2019
  2. 2010
I need procedure to add it the codes to increase & decrease form & listbox size based on showed data in listbox when run the userform or when fill textbox1 item based on column 4 ,show data in listbox , whenever the data increase in listbox then should increase the useform & listbox1 sizes and whenever the data decrease in listbox then should decrease the useform & listbox1 sizes


shape of form
1.PNG

this is the whole codes
VBA Code:
Dim a As Variant
Dim MySum As Double, MySum1  As Double

Private Sub OptionButton1_Click()
Dim lindex As Long
Dim strAdd As String

If OptionButton1.Value = True Then
     If Not Len(TextBox2) = 0 And Not Len(TextBox3) = 0 Then
          strAdd = OptionButton1.Caption & " "
          For lindex = 0 To ListBox1.ListCount - 1
               ListBox1.List(lindex, 8) = strAdd & Format(MySum, "#,##0.00")
               ListBox1.List(lindex, 9) = strAdd & Format(MySum1, "#,##0.00")
          Next
          TextBox2 = strAdd & Format(MySum, "#,##0.00")
          TextBox3 = strAdd & Format(MySum1, "#,##0.00")
     End If
End If

End Sub

Private Sub OptionButton2_Click()
Dim lindex As Long
Dim strAdd As String

If OptionButton2.Value = True Then
     If Not Len(TextBox2) = 0 And Not Len(TextBox3) = 0 Then
          strAdd = OptionButton2.Caption & " "
          For lindex = 0 To ListBox1.ListCount - 1
               ListBox1.List(lindex, 8) = strAdd & Format(MySum, "#,##0.00")
              ListBox1.List(lindex, 9) = strAdd & Format(MySum1, "#,##0.00")
          Next
          TextBox2 = strAdd & Format(MySum, "#,##0.00")
          TextBox3 = strAdd & Format(MySum1, "#,##0.00")
     End If
End If

End Sub

Private Sub OptionButton3_Click()
Dim lindex As Long
Dim strAdd As String

If OptionButton3.Value = True Then
     If Not Len(TextBox2) = 0 And Not Len(TextBox3) = 0 Then
          strAdd = OptionButton3.Caption & " "
          For lindex = 0 To ListBox1.ListCount - 1
               ListBox1.List(lindex, 8) = strAdd & Format(MySum, "#,##0.00")
              ListBox1.List(lindex, 9) = strAdd & Format(MySum1, "#,##0.00")
          Next
          TextBox2 = strAdd & Format(MySum, "#,##0.00")
          TextBox3 = strAdd & Format(MySum1, "#,##0.00")
     End If
End If

End Sub

Function FilterData()
    Dim i As Long, ii As Long, n As Long
  
    Me.ListBox1.List = a
    If Me.TextBox1 = "" Then Exit Function
    With Me.ListBox1
        .Clear
        For i = 0 To UBound(a, 1)
            If UCase$(a(i, 3)) Like UCase$(Me.TextBox1) & "*" Then
                .AddItem
                .List(n, 0) = n + 1
                For ii = 1 To UBound(a, 2)
                    .List(n, ii) = a(i, ii)
                Next
                n = n + 1
            End If
        Next
    End With
    Dim r As Long
       ''Dim MySum, MySum1  As Double 'moved and corrected
        MySum = 0
        MySum1 = 0
        With ListBox1
            For r = 0 To .ListCount - 1
                MySum = MySum + .List(r, 7)
                MySum1 = MySum1 + .List(r, 9)
            Next r
        End With
        TextBox2.Value = Format(MySum, "#,##0.00")
        TextBox3.Value = Format(MySum1, "#,##0.00")

End Function

Private Sub TextBox1_AfterUpdate()
    FilterData

End Sub

Private Sub TextBox2_AfterUpdate()
FilterData
End Sub

Private Sub TextBox3_AfterUpdate()
FilterData
End Sub

Private Sub UserForm_Initialize()
    Dim lindex&
    Dim rngDB As Range, rng As Range
    Dim i, myFormat(1) As String
    Dim sWidth As String
    Dim vR() As Variant
    Dim n As Integer
    Dim myMax As Single
    Set rngDB = Range("A2:J20")
    For Each rng In rngDB
        n = n + 1
        ReDim Preserve vR(1 To n)
        vR(n) = rng.EntireColumn.Width
    Next rng
    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
        Set rng = .Offset(1).Resize(.Rows.Count - 1)
        a = .Cells(1).CurrentRegion.Value
    End With

    sWidth = Join(vR, ";")
    Debug.Print sWidth
    With ListBox1
        .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 = 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
      
        a = .List
        '<--- this line
    End With
End Sub
thanks
 

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
The listbox columns count were not set.
I've made "DisplayData" procedure change. Replace this two parts of code.
VBA Code:
Private Sub UserForm_Initialize()

   Set vRng = Sheets("Sheet1").Range("A1", Cells(Rows.Count, "J").End(xlUp))
   With vRng.Offset(1, 0)
      Set vRng2 = .Resize(.Rows.Count - 1, .Columns.Count)
   End With
   vArray = vRng2
   Call DisplayData
   ListBox1.IntegralHeight = False
   ListBox1.ColumnCount = vRng2.Columns.Count 'this also can be done manualy
   Call CreateVirtualLabel
   Call ResizeListbox
   TextBox1.SetFocus
    
End Sub

Sub DisplayData()
   
   For vN = 1 To UBound(vArray)
      For vN2 = 1 To vRng2.Columns.Count
         vArray(vN, vN2) = vRng2.Rows(vN).Cells(vN2).Text
      Next vN2
   Next vN
   ListBox1.List = vArray
   
End Sub
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

Mussa

Board Regular
Joined
Jul 12, 2021
Messages
164
Office Version
  1. 2019
  2. 2010
thanks . two question ?
first I would make equal space amongst the columns when show data in listbox . now it's very close for each other of them
I try with this part but doesn't work
VBA Code:
Dim sWidth As Variant
With ListBox1
    sWidth = Join(vRng2, ";")
    Debug.Print sWidth
    .ColumnWidths = sWidth
   End With
second why shows scroll bar in height if the userform & listbox will resize ? then the scroll bar in height becomes useless . can get rid of it or what do you think?
 

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
I don't see any universal procedure that may give answer to more requests in the same time.
Using virtual label it's possible to calculate listbox size only approximately.
The more precisely calculation complicate procedure.
Depending of the font size, you can use "cSizeCorrection" constant to find the best view.
Complete code...
VBA Code:
Option Explicit

   Dim vRng As Range, vRng2 As Range, vArray, vN As Long, vLabelX, _
      vLHBefore As Long, vHeightIndex As Long, vLHAfter As Long, _
      vFCount As Long, vCounter As Long, vN2 As Long, sWidth, _
      vTWidth As Long, vColWidth As String, vN1 As Long, _
      vLWBefore As Long, vLWAfter As Long, vBottom As Long, _
      vAWidths, vLWidth As Long, vTitle As Long
   Const cSpace = 20
   Const cSearchColumn = 4
   Const cSizeCorrection = 7
   
Private Sub UserForm_Initialize()

   Set vRng = Sheets("Sheet1").Range("A1", Cells(Rows.Count, "J").End(xlUp))
   With vRng.Offset(1, 0)
      Set vRng2 = .Resize(.Rows.Count - 1, .Columns.Count)
   End With
   vArray = vRng2
   Call DisplayData
   vTitle = Me.Height - Me.InsideHeight
   vBottom = InsideHeight - ListBox1.Height - ListBox1.Top
   ListBox1.IntegralHeight = False
   ListBox1.ColumnCount = vRng2.Columns.Count
   Call CreateVirtualLabel
   Call ResizeListbox
   TextBox1.SetFocus

End Sub

Sub DisplayData()

   For vN = 1 To UBound(vArray)
      For vN2 = 1 To UBound(Application.Transpose(vArray))
         vArray(vN, vN2) = vRng2.Rows(vN).Cells(vN2).Text
      Next vN2
   Next vN
   ListBox1.List = vArray
   
End Sub

Sub CreateVirtualLabel()
   
    Set vLabelX = Controls.Add("Forms.Label.1", "LabelX", True)
    Set vLabelX.Font = ListBox1.Font
    With vLabelX
      .Font.Bold = ListBox1.Font.Bold
      .Font.Size = ListBox1.Font.Size
      .WordWrap = False
      .Visible = False
      .AutoSize = True
    End With

End Sub

Sub ResizeListbox()
   
   Call ResizeColumns
   With ListBox1
      vLHBefore = .Height
      vLWBefore = .Width
      Controls("LabelX").Caption = "LabelX"
      vHeightIndex = Controls("LabelX").Height
      .Height = (UBound(vArray)) * vHeightIndex + cSizeCorrection
     vAWidths = Split(.ColumnWidths, ";")
      For vN = 0 To UBound(vAWidths)
         vLWidth = vLWidth + Split(vAWidths(vN), " ")(0)
      Next vN
      .Width = vLWidth + cSizeCorrection
      vLWidth = 0
      vLHAfter = .Height
      vLWAfter = .Width
      Height = Height + (vLHAfter - vLHBefore)
      Height = ListBox1.Top + ListBox1.Height + vBottom + vTitle
      Width = Width + (vLWAfter - vLWBefore)
      ReDim vArray(0)
   End With
   
End Sub

Sub ResizeColumns()
   
    With vArray
      For vN1 = 1 To UBound(Application.Transpose(vArray))
         For vN2 = 1 To UBound(vArray)
            vLabelX.Caption = vArray(vN2, vN1)
            If Label1.Width > vTWidth Then vTWidth = vLabelX.Width
         Next vN2
         vColWidth = vColWidth & "," & vTWidth + cSpace
         vTWidth = 0
      Next
      ListBox1.ColumnWidths = Mid(vColWidth, 2)
      vColWidth = ""
   End With
   
End Sub

Private Sub TextBox1_Change()
   
   vFCount = Application.CountIf(vRng2.Columns(cSearchColumn), "*" & TextBox1 & "*")
   If TextBox1 = "" Then vFCount = vRng2.Rows.Count: vArray = vRng2: GoTo EX
   If vFCount = 0 Then GoTo EX2
   ReDim vArray(1 To vFCount, 1 To vRng2.Columns.Count)
   For vN = 1 To vRng2.Rows.Count
      If vRng2.Columns(cSearchColumn).Cells(vN) Like "*" & TextBox1 & "*" Then
         vCounter = vCounter + 1
         For vN2 = 1 To vRng2.Columns.Count
            vArray(vCounter, vN2) = vRng2.Rows(vN).Cells(vN2).Text
         Next vN2
      End If
   Next vN
   vCounter = 0
EX:
   Call DisplayData
   Call ResizeListbox
   Exit Sub
EX2:
   Height = ListBox1.Top + vTitle
 
End Sub
 
Solution

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
Correction. Do not display all data, just filtered array.
Replace this.
VBA Code:
EX:
'   Call DisplayData
   ListBox1.List = vArray
   Call ResizeListbox
   Exit Sub
 

Mussa

Board Regular
Joined
Jul 12, 2021
Messages
164
Office Version
  1. 2019
  2. 2010
perfect ! I see hidding scroll bar in width when show the data in listbox . I was also wishing for height of the listbox . may be you see very complicated . this is not problem just looking for the best sight for my project .

anyway the code fulfills all desires except one thing should be numbers sequences in column 1 1,2,3... not date as I showed in OP
thanks again
 

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
Thanks for feedback if you found this as solution, but its not enough for my taste, because I see few errors.
Change this...
1. Add new variabe declaration Dim vRng As Range, vRng2 As Range, vArray, vArray2, etc ...
2. Copy all first displayed data to this new array...
VBA Code:
Sub DisplayData()

   For vN = 1 To UBound(vArray)
      For vN2 = 1 To UBound(Application.Transpose(vArray))
         vArray(vN, vN2) = vRng2.Rows(vN).Cells(vN2).Text
      Next vN2
   Next vN
   ListBox1.List = vArray
'add
   vArray2 = vArray
  
End Sub
3. You can clear "ReDim vArray(0)" in the "ResizeListbox" procedure
4. Change this in the end of the "TextBox1_Change" event
VBA Code:
   vCounter = 0
   ListBox1.List = vArray
   Call ResizeListbox
   Exit Sub
EX: vArray = vArray2
   ListBox1.List = vArray
   Call ResizeListbox
   Exit Sub
EX2:
   Height = ListBox1.Top + vTitle
 
End Sub
About scrollbars.
Code should resize number of rows, fit listbox column widths, fit listbox height, fit userform height and width.
About column "A" dates.
Change format date in column "A" to number format.
Try.
 

Mussa

Board Regular
Joined
Jul 12, 2021
Messages
164
Office Version
  1. 2019
  2. 2010
Thanks for feedback if you found this as solution
actually you did it without any doubt.;)
but its not enough for my taste, because I see few errors.
I hope to doesn't be error in the futre . it seems to work without problem
Code should resize number of rows, fit listbox column widths, fit listbox height, fit userform height and width.
this is what happens but I no know why show scrollbars in just height when increase data despite of all of data show in listbox without need using scrollbar as in pic
1.PNG



About column "A" dates.
Change format date in column "A" to number format.
I mean in listbox not inside the sheet
 

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
Correction.
Declare "vHeightIndex" and "Width" as Double to calculate decimals. It's more precisely.
Set "Const cSizeCorrection=5" or try to change to find the best view.
If you want to show numbers in the column "A" you can add "If" statement.
VBA Code:
Sub DisplayData()

   For vN = 1 To UBound(vArray)
      For vN2 = 1 To UBound(Application.Transpose(vArray))
         If vN2 = 1 Then
            vArray(vN, vN2) = vN
         Else
            vArray(vN, vN2) = vRng2.Rows(vN).Cells(vN2).Text
         End If
      Next vN2
   Next vN
   ListBox1.List = vArray
   vArray2 = vArray
   
End Sub
And in the "Change" event too.
VBA Code:
Private Sub TextBox1_Change()
   
   vFCount = Application.CountIf(vRng2.Columns(cSearchColumn), "*" & TextBox1 & "*")
   If TextBox1 = "" Then vFCount = vRng2.Rows.Count: vArray = vRng2: GoTo EX
   If vFCount = 0 Then GoTo EX2
   ReDim vArray(1 To vFCount, 1 To vRng2.Columns.Count)
   For vN = 1 To vRng2.Rows.Count
      If vRng2.Columns(cSearchColumn).Cells(vN) Like "*" & TextBox1 & "*" Then
         vCounter = vCounter + 1
            For vN2 = 1 To vRng2.Columns.Count
               If vN2 = 1 Then
                  vArray(vCounter, vN2) = vN
               Else
                  vArray(vCounter, vN2) = vRng2.Rows(vN).Cells(vN2).Text
              End If
         Next vN2
      End If
   Next vN
   vCounter = 0
About errors. Sorry for them. It's part of coding and learning.
It's good for keep attention.
 

Mussa

Board Regular
Joined
Jul 12, 2021
Messages
164
Office Version
  1. 2019
  2. 2010
thanks again I appreciate for your effort , you're welcome for adjusting anything need correcting. so you see there is no way to hide scrollbar in height?
 

Forum statistics

Threads
1,176,098
Messages
5,901,381
Members
434,887
Latest member
zoath

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
Top