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

[Mussa]

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

this is the whole codes

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]

The listbox columns count were not set.
I've made "DisplayData" procedure change. Replace this two parts of 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

 

[Mussa]

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

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]

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...

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

 

[EXCEL MAX]

Correction. Do not display all data, just filtered array.
Replace this.

EX:
'   Call DisplayData
   ListBox1.List = vArray
   Call ResizeListbox
   Exit Sub

 

[Mussa]

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]

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...

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

   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]

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

About column "A" dates.
Change format date in column "A" to number format.

I mean in listbox not inside the sheet

 

[EXCEL MAX]

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.

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.

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]

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?