add procedure to userform to resize form based on addition text boxes

[MKLAQ]

Hi experts,
I hope somebody provide me procedure to resize the userform based on add textboxes automatically
the code will add textboxes based on data in sheet . the data in sheet contain four columns so it will add three columns on userform and the rows on userform depends on the last row in sheet.
is there any procedure to add the userform when run it?
should resize the userform by increase or decrease based on how many added textboxes on form?
this is the code

Option Explicit

Const dateCol = 1
Const invoiceNumCol = 2
Const amountCol = 3
Const paymentCol = 4

Private Sub SaveButton_Click()
    Dim row As Range
    Dim box As Control

    For Each row In ActiveSheet.Rows
        On Error GoTo ExitHandler
        row.Cells(1, paymentCol).Value = Me.Controls(row.row & paymentCol).Value
    Next row

ExitHandler:
    Exit Sub
End Sub



Private Sub UserForm_Initialize()
    Dim row As Range

    For Each row In ActiveSheet.Rows
     
        If row.Cells(1, dateCol).Value = "" Then
       
            Exit For
        End If
        'End If

        Call AddBox(row, dateCol)
        Call AddBox(row, invoiceNumCol)
        Call AddBox(row, amountCol)
        Call AddBox(row, paymentCol)
    Next row
End Sub

Private Sub AddBox(row, colIndex)
    Dim box As Control

    Const width = 50
    Const padWidth = width + 4
    Const height = 15
    Const padHeight = height + 4
    Const topMargin = 25
    Const leftMargin = 5
    Const frmspecialeffectbump = 6
    Set box = Me.Controls.Add("Forms.TextBox.1", row.row & colIndex)
    box.Left = (colIndex - 1) * padWidth + leftMargin
    box.height = height
    box.width = width
    box.Top = (row.row - 1) * padHeight + topMargin
    box.Value = row.Cells(1, colIndex).Value
End Sub

I hope somebody help .

 

[MKLAQ]

sorry I'm asking too much . I add this condition as bold

For row = 2 To vLastRow
            If .Cells(row, dateCol).Value = "" Then
                Exit For
            End If
            If .Cells(row, dateCol).Offset(, 2) < 0 Then
            Call AddBox(row, dateCol)
            Call AddBox(row, invoiceNumCol)
            Call AddBox(row, amountCol)
           ' Call AddBox(row, paymentCol)
            vTCounter = vTCounter + 1
            End If
        Next row
    End With

it occurs problem about move the text boxes in down and create spaces above . I try fixing many times but I failed
any idea ,please?

 

[EXCEL MAX]

It's hard to analyse data by changing code while creating textboxes.
It will be better to prepare data before you want to show them in the textboxes.

 

[MKLAQ]

I thought there is way to show the textboxes & the data are existed in sheet based on condition without affect moving the textboxes where create spaces above as in picture like inside the sheet when replace the new data for old data will clear and start again for the new data from row2 . the same thing the textboxes should start from above and increase to bottom based on size of data like replace data .

 

[EXCEL MAX]

I'm afraid that not understand this new request.
Here is one changed procedure that may helps you to better understand flow of actions.
In the beginning userform creates textboxes according to the data in the four columns.
Also, all of them will be filled by data.
When you press button procedure clear textboxes data and fill them with data according to the criteria,
but keep original textboxes.

Option Explicit

Dim vFormHeader As Long, vFromBottom As Long, vLastRow As Long, vRow As Long
Dim vTCounter As Long, vNBox As Long, vN As Long
Dim vBox As Control, vRng As Range
Dim vR As Range, vRow2 As Range, vNRows As Long, vX As Long

Const cDateCol = 1
Const cInvoiceNumCol = 2
Const cAmountCol = 3
Const cPaymentCol = 4
Const cHeight = 15
Const cPadHeight = cHeight + 4
Const cTopMargin = 25
Const cBottom = 100
Const cFrmSpecialEffectBump = 6
Const cWidth = 50
Const cPadWidth = cWidth + 4
Const cLeftMargin = 5

Private Sub UserForm_Initialize()
    vFormHeader = Me.height - Me.InsideHeight
    vFromBottom = Me.InsideHeight - CommandButton1.Top - CommandButton1.height
    With ActiveSheet
        vLastRow = .Cells(Rows.Count, "A").End(xlUp).row
        Set vRng = Range("A2:D" & vLastRow)
        For vRow = 2 To vLastRow
            Call AddBox(vRow, cDateCol)
            Call AddBox(vRow, cInvoiceNumCol)
            Call AddBox(vRow, cAmountCol)
            Call AddBox(vRow, cPaymentCol)
            vTCounter = vTCounter + 1
        Next vRow
    End With
    Me.height = vTCounter * cPadHeight + cTopMargin + cBottom + vFormHeader
    CommandButton1.Top = Me.InsideHeight - CommandButton1.height - vFromBottom
End Sub


Private Sub AddBox(vRow, colIndex)
    vNBox = vNBox + 1
    Set vBox = Me.Controls.Add("Forms.TextBox.1", "MyTextBox" & vNBox)
    vBox.Left = (colIndex - 1) * cPadWidth + cLeftMargin
    vBox.height = cHeight
    vBox.width = cWidth
    vBox.Top = (vRow - 2) * cPadHeight + cTopMargin
    vBox.Value = ActiveSheet.Cells(vRow, colIndex).Value
End Sub

Private Sub UserForm_AddControl(ByVal Control As MSForms.Control)
    With Control
        .SpecialEffect = cFrmSpecialEffectBump
        .Font.Name = "Britannic"
        .TextAlign = 2
        .Font.Size = 8
    End With
End Sub

Private Sub CommandButton1_Click()
   Call ClearData
   Call FilterRows
End Sub

Sub ClearData()
   For vN = 1 To vNBox
      Controls("MyTextBox" & vN) = ""
   Next vN
End Sub

Sub FilterRows()
   Application.ScreenUpdating = False
   With ActiveSheet
      Set vRng = .Range("A1").Resize(vLastRow, 4)
'here you can change criteria for search
      vRng.Columns(3).AutoFilter 1, "<0"
      Call FillFilteredRows
      ActiveSheet.ShowAllData
      vRng.Columns(3).AutoFilter
   End With
   Application.ScreenUpdating = True
End Sub

Sub FillFilteredRows()
      On Error GoTo EX
      Set vRng = ActiveSheet.Range("A2:D" & vLastRow).SpecialCells(xlVisible)
      For Each vR In vRng.Areas
         For Each vRow2 In vR.Rows
            vX = vNRows * 4
            Controls("MyTextBox" & vX + 1) = vRow2.Cells(1)
            Controls("MyTextBox" & vX + 2) = vRow2.Cells(2)
            Controls("MyTextBox" & vX + 3) = vRow2.Cells(3)
            Controls("MyTextBox" & vX + 4) = vRow2.Cells(4)
            vNRows = vNRows + 1
         Next vRow2
      Next vR
      vNRows = 0
      Exit Sub
EX:
End Sub

 

[MKLAQ]

I'm afraid that not understand this new request.

my apologies ! sometimes there are some things I don't expect happening , it gets hard knowing what happens in the next step
I hope you will accept my excuses .
the code works Fabulously
just I want to understand

When you press button procedure clear textboxes data and fill them with data according to the criteria,
but keep original textboxes.

why add this procedure to clear the textboxes if the code shows data and create the textboxes based on size of data ?
what's the point?

 

[EXCEL MAX]

If you want to make some kind of dynamic filter you can change search criteria and fill new data.
If the new data is smaller than loaded data it's needed to clear old data,
otherwise may be you not get desired result.
Try with clearing and without clearing.

Private Sub CommandButton1_Click()
   Call FilterRows
End Sub

Sub FilterRows()
   Dim vCriteria
   vCriteria = InputBox("Insert or change criteria to show data " & _
      "in column 3 according to search criteria.", "Criteria Box", "<0")
   If Not vCriteria = "" Then
'      Call ClearData
      Application.ScreenUpdating = False
      With ActiveSheet
         Set vRng = .Range("A1").Resize(vLastRow, 4)
         vRng.Columns(3).AutoFilter 1, vCriteria
         Call FillFilteredRows
         ActiveSheet.ShowAllData
         vRng.Columns(3).AutoFilter
      End With
      Application.ScreenUpdating = True
   End If
End Sub

 

[MKLAQ]

now I understood the code in post # 14 when clear the data in textboxes just fill the values <0 without delete textboxes are empty & resize the userform
the code in post#16 filter data without clear old data

so what I look for it delete textboxes are empty & resize the userform after clear the data basedon post#15

if you see this is extremely hard I will satisfy the code in post#14 and I will try to search for another procedure to do that.

thanks again

 

[dmt32]

so what I look for it delete textboxes are empty & resize the userform after clear the data basedon post#15

Do you mean just display the number of textboxes with data that meet your < 0 criteria as in example pic?

 

[MKLAQ]

@dmt32 yes that's correct

 

[dmt32]

OK, I have only glanced at content of this thread but see if following update to your code does what you want

- Make a BACKUP of your workbook

- DELETE ALL Existing Code & variables.

Place following codes in your userform code page

Option Explicit

Private Sub UserForm_Initialize()
    Dim rRow        As Long
    Dim vLastRow    As Long, r As Long
    
    Const NoColumns As Long = 4
    
    With ActiveSheet
        vLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        For rRow = 2 To vLastRow
            With .Cells(rRow, 1)
                If Len(.Value) > 0 Then
                    If Val(.Offset(, 2).Value) < 0 Then Call AddBox(rRow, NoColumns)
                End If
            End With
        Next rRow
    End With
    
End Sub

Private Sub AddBox(ByVal CellRow As Long, ByVal ColumnCount As Long)
    Dim i                   As Long
    Dim Box                 As Control
    Dim ButtonAlign         As fmAlignment
    Dim BoxSpecialEffect    As fmSpecialEffect
    
    Static LineRow          As Long, BoxIndex As Long
    
    '------------------------------------------------------------------------------------------------
    '                                           SETTINGS
    '------------------------------------------------------------------------------------------------
    'select align button to left or right of textboxes
    ButtonAlign = fmAlignmentRight
    'select required effect
    BoxSpecialEffect = fmSpecialEffectBump
    
    Const BoxHeight     As Long = 18
    Const BoxWidth      As Long = 50
    Const BoxFontSize   As Long = 8
    Const BoxFontName   As String = "Britannic"
    
    Const Leftmargin    As Long = 6
    Const Topmargin     As Long = 25
    
    Const Hspace        As Long = BoxWidth + 4
    Const Vspace        As Long = BoxHeight + 4
   
    '--------------------------------------------------------------------------------------------------
    
    LineRow = LineRow + 1
    
    For i = 1 To ColumnCount
        BoxIndex = BoxIndex + 1
        'add & name textbox
        Set Box = Me.Controls.Add("Forms.TextBox.1", "TextBox" & BoxIndex)
        
       With Box
        .Left = (i - 1) * Hspace + Leftmargin
        .Height = BoxHeight
        .Width = BoxWidth
        .Top = (LineRow - 1) * Vspace + Topmargin
        .Value = ActiveSheet.Cells(CellRow, i).Value
        
        .SpecialEffect = BoxSpecialEffect
        .Font.Name = BoxFontName
        .TextAlign = 2
        .Font.Size = BoxFontSize

        .Tag = CellRow
       End With
    Next i
    
    'place commandbutton
    With Me.CommandButton1
        .Left = IIf(ButtonAlign = fmAlignmentLeft, Leftmargin, Box.Left + BoxWidth - .Width)
        .Top = Box.Top + Box.Height + Vspace
        
   'size form height & width
        Me.Height = .Top + (.Height * 3)
        Me.Width = Box.Left + BoxWidth * 1.5
    End With
    
    Set Box = Nothing
End Sub

You can make any adjustments needed in the settings section.

The naming convention for created textboxes follows default names - "TextBox1" TextBox2" etc

Solution takes a slightly different approach & has been only lightly tested but hopefully, will do what you want

Dave