Userform to fill first empty row in named table

Retroshift

Board Regular
Joined
Sep 20, 2016
Messages
119
Office Version
  1. 2019
Platform
  1. Windows
Hi,

I have a userform with text fields and checkboxes. The data entered in the userform will be transfered to a new row in the named table "tblColleagues". This table already contains a few rows with data but the named table range also covers lots of empty rows. How is it possible to make the userform data being entered in the first entirely empty row starting from the top below the header to the bottom of the named table? The code below only adds new rows after the bottom of the named range, ignoring all the empty rows within the table itself.
The data input of "fullparttime" should also be limited to a number =>0<=100 as this is a percentage.
Anyone has an idea on how to alter the code below accordingly?

VBA Code:
Sub cbAdd_Click()
Dim firstname As String
firstname = txtFirstName.Text

Dim lastname As String
lastname = txtLastName.Text

Dim shortname As String
shortname = txtShortName.Text

Dim fullparttime As String
fullparttime = txtFullparttime.Text 'incorrect data type? percentage

Dim wsh As Worksheet
Set wsh = ThisWorkbook.Worksheets("List")

Set tbl = wsh.ListObjects("tblColleagues")

Dim newRow As ListRow
Set newRow = tbl.ListRows.ADd  'positioning needs to loop within the named table "tblColleagues" until the first empty row, starting from the first row below the header

With newRow
.Range(1) = firstname
.Range(2) = lastname
.Range(3) = shortname
.Range(5) = fullparttime 'Condition: numeric =>0<=100 as this is a percentage

If cbx1.Value = True Then
.Range(4) = "x"
End If

If cbx2.Value = True Then
.Range(6) = "x"
End If

End With

End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
See if this works for you. Kind of tough without seeing your form, but I think this might do it, or at least get you closer...

VBA Code:
Private Sub cbAdd_Click()
    Dim fEr As Long
    Dim tbl As ListObject
    Dim firstname As String
    firstname = txtFirstName.Text
    
    Dim lastname As String
    lastname = txtLastName.Text
    
    Dim shortname As String
    shortname = txtShortName.Text
    
    Dim fullparttime As Single
    fullparttime = txtFullparttime.Value / 100   'incorrect data type? percentage

    Dim wsh As Worksheet
    Set wsh = ThisWorkbook.Worksheets("List")
    
    Set tbl = wsh.ListObjects("tblColleagues")

    fEr = tbl.DataBodyRange(1, 1).End(xlDown).Row + 1
    If fEr < tbl.ListRows.Count + tbl.HeaderRowRange.Row Then
        fEr = fEr - tbl.HeaderRowRange.Row
    Else
        tbl.ListRows.Add AlwaysInsert:=True
        fEr = tbl.ListRows.Count
    End If
        With tbl.ListRows(fEr)
            .Range(1) = firstname
            .Range(2) = lastname
            .Range(3) = shortname
            .Range(5) = FormatPercent(fullparttime) 'Condition: numeric =>0<=100 as this is a percentage
    
    If cbx1.Value = True Then
    .Range(4) = "x"
    End If
    
    If cbx2.Value = True Then
    .Range(6) = "x"
    End If
    
    End With

End Sub
 
Upvote 0
Hi igold, thanks for your answer so far. The line "fullparttime = txtFullparttime.Value / 100" gives an error when I run the macro.
When I remove the lines having regard to the fullparttime, in order to test the rest of the code, the code does not enter the userform data into the first entirely blank row but keeps overwriting the data in a specific row that has some empty cells in its row. Do you know how to overcome the data type bug and the overwriting issue?
 
Upvote 0
For the percentage, how are you entering the number in the textbox. I entered it as "30" (sans quotes) and it tested for me. Also, the code is only looking down the first column of the Table to find an empty cell and filling that row. If no empty cell is found it is adding a row.
I had to make a mock up Table and Form to write the code. On what I created, the code works. If you would like to post your data (Table & UserForm) so that I can see what you have, that would be great. Also, did you directly try my code or did you make alterations. If you post the code you are using as well that would be helpful.
 
Upvote 0
This should take care of overwriting rows with data in them. I cannot address your percentage error unless I see either your code or your data. Also, I changed the formatting of your code to make it easier for me to work with. Same code, I just moved the Declarations together at the top of the code...

VBA Code:
Private Sub cbAdd_Click()
    Dim fEr As Long, r As Long, c As Long, i As Long
    Dim firstname As String, lastname As String, shortname As String
    Dim fullparttime As Single
    Dim wsh As Worksheet: Set wsh = ThisWorkbook.Worksheets("List")
    Dim tbl As ListObject: Set tbl = wsh.ListObjects("tblColleagues")
   
    firstname = txtFirstName.Text
    lastname = txtLastName.Text
    shortname = txtShortName.Text
    fullparttime = txtFullparttime.Value / 100   'incorrect data type? percentage
    r = 1
    For r = 1 To tbl.ListRows.Count
        For c = 1 To tbl.ListRows(r).Range.Column - 1
            If tbl.ListRows(r).Range.Formula2(1, c) <> "" Then
                Exit For
            End If
            If c = tbl.ListRows(r).Range.Column - 1 Then i = r
        Next
        If i > 0 Then Exit For
    Next
           
    If r = tbl.ListRows.Count Then
        tbl.ListRows.Add AlwaysInsert:=True
        r = tbl.ListRows.Count
    End If
        With tbl.ListRows(r)
            .Range(1) = firstname
            .Range(2) = lastname
            .Range(3) = shortname
            .Range(5) = FormatPercent(fullparttime) 'Condition: numeric =>0<=100 as this is a percentage
   
    If cbx1.Value = True Then
    .Range(4) = "x"
    End If
   
    If cbx2.Value = True Then
    .Range(6) = "x"
    End If
   
    End With

End Sub
 
Upvote 0
Please disregard the code posted in Post #5. It is flawed. Try this instead...

VBA Code:
Private Sub cbAdd_Click()
    Dim r As Long, c As Long, i As Long
    Dim firstname As String, lastname As String, shortname As String
    Dim fullparttime As Single
    Dim wsh As Worksheet: Set wsh = ThisWorkbook.Worksheets("List")
    Dim tbl As ListObject: Set tbl = wsh.ListObjects("tblColleagues")
   
    firstname = txtFirstName.Text
    lastname = txtLastName.Text
    shortname = txtShortName.Text
    fullparttime = txtFullparttime.Value / 100   'incorrect data type? percentage

    For r = 1 To tbl.ListRows.Count
        For c = 1 To tbl.ListColumns.Count
            If tbl.ListRows(r).Range.Formula2(1, c) <> "" Then
                Exit For
            End If
            If c = tbl.ListColumns.Count Then i = r
        Next
        If i > 0 Then Exit For
    Next
    If r > tbl.ListRows.Count Then
        tbl.ListRows.Add AlwaysInsert:=True
        r = tbl.ListRows.Count
    End If
        With tbl.ListRows(r)
            .Range(1) = firstname
            .Range(2) = lastname
            .Range(3) = shortname
            .Range(5) = FormatPercent(fullparttime) 'Condition: numeric =>0<=100 as this is a percentage
   
    If cbx1.Value = True Then
    .Range(4) = "x"
    End If
   
    If cbx2.Value = True Then
    .Range(6) = "x"
    End If
   
    End With

End Sub
 
Upvote 0
Hi igold, I tried the code just above, but the line "If tbl.ListRows(r).Range.Formula2(1, c) <> "" Then" returns error 1004.
Also, the percentage data type returns runtime error 13 when the text field is left blank in the userform, and when the entered data is non-numeric. I would like to make the entry of the text field loop until it is an integer =>0<=100 (without any decimals, since the dedicated table column is already formatted to percentages).

To find and go to the next entirely empty row (see for example the image of the table below: row 3 which is directly under the table header in row 2, and then row 10, 11 etc.), maybe the following code could work/be implemented in the existing code somehow?
VBA Code:
If Application.WorksheetFunction.CountA(.ListRows(ListRows.Count).Range) = 0 Then
                .ListRows(ListRows.Count).add
                End If

As you asked, you find below my code (additional to your code in the previous post), my table, and the userform.
VBA Code:
'...your code from the previous post

Select Case ListBox1.Value
Case ListBox1.Value = "0 (no group)"
Case ListBox1.Value = "1"
.Range(16) = "x"
Case ListBox1.Value = "2"
.Range(17) = "x"
Case ListBox1.Value = "3"
.Range(18) = "x"
Case ListBox1.Value = "4"
.Range(19) = "x"
Case ListBox1.Value = "5"
.Range(20) = "x"
Case ListBox1.Value = "6"
.Range(21) = "x"
Case ListBox1.Value = "7"
.Range(22) = "x"
End Select

End With
End Sub

Private Sub cbExit_Click()
Unload UserForm1
End Sub

Private Sub UserForm_Initialize()
ListBox1.AddItem "0 (no group)"
ListBox1.AddItem "1"
ListBox1.AddItem "2"
ListBox1.AddItem "3"
ListBox1.AddItem "4"
ListBox1.AddItem "5"
ListBox1.AddItem "6"
ListBox1.AddItem "7"
End Sub

The code for the Add person button:
Code:
Sub ShowForm()
UserForm1.Show
End Sub

The table and the button to show the userform:
table example.jpg

The userform:
add person userform.jpg
 
Upvote 0
In you picture of your table, what is the current last row of the table.
 
Upvote 0
There is no reason that I can see why this line would throw a 1004 Error
VBA Code:
If tbl.ListRows(r).Range.Formula2(1, c) <> "" Then
All that line is doing is looking at the value in tbl.DataBodyRange(1,1), which would be the very first cell below the Header. This and the fact that in your picture, you would have had to make a concerted effort to make the Table look like a range, I could understand if you did not want the alternating colors for the rows but also you would have had to remove or disguise the outer border of the table to look like regular worksheet grid lines.
All that being said, and the fact that the code tested for me on multiple Tables that I created, I would ask that you post your worksheet using XL2BB. Short of that, I don't think I can help you any further.
 
Upvote 0

Forum statistics

Threads
1,214,588
Messages
6,120,409
Members
448,959
Latest member
camelliaCase

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