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 Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Mussa

Board Regular
Joined
Jul 12, 2021
Messages
164
Office Version
  1. 2019
  2. 2010
this code for @EXCEL MAX
VBA Code:
Option Explicit

Dim varLabelX As Object
Dim varNRows As Long
Dim varHeightIndex, varDifference


Private Sub UserForm_Initialize()
    
    Call CreateVirtualLabel
   
End Sub


Sub CreateVirtualLabel()
    
    Set varLabelX = Controls.Add("Forms.Label.1", "LabelX", True)
    With varLabelX
        .Top = -100
        .Caption = "LabelX"
        .Left = -100
        .AutoSize = True
        .WordWrap = False
    End With
    Set varLabelX.Font = ListBox1.Font
    varHeightIndex = Controls("LabelX").Height
    Call ResizeListbox
    
End Sub


Sub ResizeListbox()

    varDifference = CommandButton1.Top - ListBox1.Height - ListBox1.Top
    varNRows = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    ListBox1.RowSource = "Sheet1!A1:A" & varNRows + 1
    ListBox1.Height = (varNRows + 1) * varHeightIndex
    ListBox1.RowSource = "Sheet1!A1:A" & varNRows
    CommandButton1.Top = ListBox1.Top + ListBox1.Height + varDifference
    ListBox1.IntegralHeight = False
    
End Sub


Private Sub UserForm_Terminate()
    
    Controls.Remove "LabelX"
    
End Sub
but I can't deal with it , any body help,please?
 

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
Hello Musa,
I've tried to initiate your old code and won't work as expected.
Also, I've create new procedure that will resize listbox and userform according to all data in the "Sheet1".
I don't understand what you mean "...when fill textbox1 item based on column 4...".
Perhaps that you want to filter data in the column "D" by textbox text as parameter,
after that to fill listbox with filterd data and in the end to resize listbox and userform to the optimum height.
 

Mussa

Board Regular
Joined
Jul 12, 2021
Messages
164
Office Version
  1. 2019
  2. 2010
Hi,
I don't understand what you mean "...when fill textbox1 item based on column 4...".
Perhaps that you want to filter data in the column "D" by textbox text as parameter,
yes filter data in the column "D" by textbox text
after that to fill listbox with filterd data and in the end to resize listbox and userform to the optimum height.
yes should be
if you need the file to test it , I will attach it . just inform me

thanks
 

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
Let's try in this way.
Make a new user form with textbox and listbox controls, set listbox columns count,
create example sheet "Sheet1" with data "A1:J20", put this code in userform module and test it.
VBA Code:
Option Explicit

Dim vWS As Worksheet, vRng As Range, vArray, vLabelX
Dim vNRows As Long, vNColumns As Integer, vLHBefore As Long, _
   vHeightIndex As Long, vLHAfter As Long, vRC As Long, vNAreas As Long, _
   vArea As Long, vAreaRows As Long, vN1 As Long, vN2 As Long
   
Private Sub UserForm_Initialize()
   
   Set vWS = Sheets("Sheet1")
   With vWS
      vNRows = .Cells(Rows.Count, 1).End(xlUp).row
      Set vRng = .Range("A2:J" & vNRows)
      vNColumns = vRng.Columns.Count
      vArray = vRng
   End With
   ListBox1.IntegralHeight = False
   Call CreateVirtualLabel
   Call ResizeListbox
   Set vRng = vRng.Offset(-1, 0).Resize(vNRows, vNColumns)
   TextBox1.SetFocus
   
End Sub

Private Sub TextBox1_Change()
   
   Dim vNewRow As Long
  
   Set vRng = vWS.Range("A2:J" & vNRows)
   If TextBox1 = "" Then vArray = vRng: GoTo EX
   With vRng
      .AutoFilter 4, "*" & TextBox1 & "*"
      vRC = .Columns(1).SpecialCells(xlVisible).Count
      If vRC = 1 Then ReDim vArray(0): GoTo EX
      ReDim vArray(1 To vRC - 1, 1 To vNColumns)
      vNAreas = .SpecialCells(xlVisible).Areas.Count
      For vArea = 2 To vNAreas
         With .SpecialCells(xlVisible).Areas(vArea)
            vAreaRows = .Rows.Count
            For vN1 = 1 To vAreaRows
               vNewRow = vNewRow + 1
                  For vN2 = 1 To vNColumns
                     vArray(vNewRow, vN2) = .Cells(vN2).Value
                  Next vN2
            Next vN1
            End With
      Next vArea
EX: ListBox1.List = vArray
      On Error Resume Next
      vWS.ShowAllData
      .Columns(4).AutoFilter
   End With
   Call ResizeListbox
   
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
      .Font.Italic = ListBox1.Font.Italic
      .AutoSize = True
      .WordWrap = False
      .Visible = False
    End With

End Sub

Sub ResizeListbox()

    With vWS
      vLHBefore = ListBox1.height
      ListBox1.List = vArray
      Controls("LabelX").Caption = "LabelX"
      vHeightIndex = Controls("LabelX").height
      ListBox1.height = (UBound(vArray) + 1) * vHeightIndex
      vLHAfter = ListBox1.height
   End With
   height = height + (vLHAfter - vLHBefore)

End Sub
 

Mussa

Board Regular
Joined
Jul 12, 2021
Messages
164
Office Version
  1. 2019
  2. 2010
thanks your code resize the listbox & userform , but when write the item in textbox1 doesn't show data in listbox also should show the data in listbox when run the userform from the first time as in OP with considering show the numberformat & currency as in existed in column I,J like this LYD 1,000.00
 

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
Yes, you are right, this was bad approach.
If is only this a problem you can try this version.
Note, If you intend to have lone numbers in column "D",
it should be formatted as text before entering data, otherwise an error may occur.
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

Private Sub UserForm_Initialize()
   
   Set vRng = Sheets("Sheet1").Range("A1:J20")
   With vRng.Offset(1, 0)
      Set vRng2 = .Resize(.Rows.Count - 1, .Columns.Count)
   End With
   vArray = vRng2
   Call DisplayData
   ListBox1.IntegralHeight = False
   Call CreateVirtualLabel
   Call ResizeListbox
   TextBox1.SetFocus
    
End Sub

Sub DisplayData()
   
   For vN = 1 To UBound(vArray)
      vArray(vN, 9) = Format(vArray(vN, 9), """LYD""  #,##0.00")
      vArray(vN, 10) = Format(vArray(vN, 10), """LYD""  #,##0.00")
   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
      .Font.Italic = ListBox1.Font.Italic
      .AutoSize = True
      .WordWrap = False
      .Visible = False
    End With

End Sub

Sub ResizeListbox()
   
   With ListBox1
      vLHBefore = .height
      .List = vArray
      Controls("LabelX").Caption = "LabelX"
      vHeightIndex = Controls("LabelX").height
      .height = (UBound(vArray) + 1) * vHeightIndex
      vLHAfter = .height
      height = height + (vLHAfter - vLHBefore)
      ReDim vArray(0)
   End With

End Sub

Private Sub TextBox1_Change()

   vFCount = Application.CountIf(vRng2.Columns(4), "*" & TextBox1 & "*")
   If TextBox1 = "" Then vFCount = vRng2.Rows.Count: vArray = vRng2: GoTo EX
   If vFCount = 0 Then
      ReDim vArray(0)
   Else
      ReDim vArray(1 To vFCount, 1 To vRng2.Columns.Count)
      For vN = 1 To vRng2.Rows.Count
         If vRng2.Columns(4).Cells(vN) Like "*" & TextBox1 & "*" Then
            vCounter = vCounter + 1
            For vN2 = 1 To vRng2.Columns.Count
               vArray(vCounter, vN2) = vRng2.Rows(vN).Cells(vN2)
               If vN2 = 9 Or vN2 = 10 Then vArray(vCounter, vN2) = _
                  Format(vRng2.Rows(vN).Cells(vN2), """LYD""  #,##0.00")
            Next vN2
         End If
      Next vN
   End If
   vCounter = 0
EX:
   Call DisplayData
   Call ResizeListbox
    
End Sub
 

Mussa

Board Regular
Joined
Jul 12, 2021
Messages
164
Office Version
  1. 2019
  2. 2010
unfortunately doesn't still show anything in listbox
 

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
Tell me few things.
Do you still successfully load data to the listbox with formatted text in the columns 9 i 10?
Did you try to make example workbook with sheet called "Sheet1"?
Does data in this sheet looks as data in the picture?
This procedure is just example with hopes that you will be abble to implement on option buttons and other textboxes.
This procedure works well, but not as you want.
Tell me what you actualy expecting? Tell me more and we can adapt code.
Attach the file for testing.
 

Mussa

Board Regular
Joined
Jul 12, 2021
Messages
164
Office Version
  1. 2019
  2. 2010
brief answer . your code works as what I want as to resize the listbox & userform based on populate data in listbox or write item in textbox1, but the problem is there are no any data in listbox when run the userform .o_O
here is the file search on userform (2) (2).xlsm
 

Forum statistics

Threads
1,175,533
Messages
5,897,971
Members
434,688
Latest member
vi28

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