Autofill a table based on the input provided in a userform

Question

Good morning,

I have the following code:

Option Explicit

 Private Sub CommandButton1_Click()
 Dim LastRowA As Long, LastRowB As Long, LastRowC As Long, lastrowD As Long, LastrowE As Long, 
 LastrowF As Long, LastrowG As Long, LastrowH As Long, LastrowI As Long, LastrowK As Long, LastrowL 
 As Long
 Dim ws As Worksheet

 Set ws = Sheets("Sheet1")

LastRowA = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row
LastRowB = ws.Range("B" & Rows.Count).End(xlUp).Row + 1
LastRowC = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
lastrowD = ws.Range("D" & Rows.Count).End(xlUp).Row + 1
LastrowE = ws.Range("E" & Rows.Count).End(xlUp).Row + 1
LastrowF = ws.Range("F" & Rows.Count).End(xlUp).Row + 1
LastrowG = ws.Range("G" & Rows.Count).End(xlUp).Row + 1
LastrowH = ws.Range("H" & Rows.Count).End(xlUp).Row + 1
LastrowI = ws.Range("I" & Rows.Count).End(xlUp).Row + 1
LastrowK = ws.Range("K" & Rows.Count).End(xlUp).Row + 1
LastrowL = ws.Range("L" & Rows.Count).End(xlUp).Row + 1

ws.Range("A" & LastRowA).Value = JobID.Text 'Adds the TextBox3 into Col A & Last Blank Row
ws.Range("B" & LastRowB).Value = Surveyor.Text
ws.Range("C" & LastRowC).Value = DateBox.Text
ws.Range("D" & LastRowC).Value = AddressBox.Text
ws.Range("E" & LastrowE).Value = CityBox.Text
ws.Range("F" & LastrowF).Value = PostcodeBox.Text
ws.Range("G" & LastrowG).Value = THPBox.Text
ws.Range("H" & LastrowH).Value = ChamberBox.Text
ws.Range("I" & LastrowI).Value = ORFibreBox.Text
ws.Range("K" & LastrowK).Value = ("=I" & LastrowI & "*5")


 End Sub

which helps me to autofill the table columns based on the user form.

The code is valid, but I am wondering how can I write it smarter. Is it possible at all?

Answer 1

Whenever you find yourself writing a block of nearly identical code, I recommend creating a common function that simplifies and isolates that functionality. The advantage is that you now have a single location for the logic and can easily make a change that is consistent for each instance you need to use that logic. In your case, you are repeatedly finding the last row in a column and adding a value to the first empty row in that column. So create a separate routine for that.

You have three tricky parts. The first is that you're not always adding a value. In at least one case, you want to add a formula. For this, I created a simple enumeration type as an optional parameter. The second is you wanted to use the row index in your formula, so that row index value is returned from the function to use if needed. The last tricky bit is adding a value to a column that is completely empty. You can't blindly always add one to the lastRow value because you'll end up skipping that top row. This isn't always a problem since many folks reserve the first row for a column header, but the function takes this into account to be thorough.

Option Explicit

Private Enum DataType
    DataValue
    FormulaValue
End Enum

Private Sub CommandButton1_Click()
    AppendToColumn Sheet1, "A", JobID.Text  'Adds the TextBox3 into Col A & Last Blank Row
    AppendToColumn Sheet1, "B", Surveyor.Text
    AppendToColumn Sheet1, "C", DateBox.Text
    AppendToColumn Sheet1, "D", AddressBox.Text
    AppendToColumn Sheet1, "E", CityBox.Text
    AppendToColumn Sheet1, "F", PostcodeBox.Text
    AppendToColumn Sheet1, "G", THPBox.Text
    AppendToColumn Sheet1, "H", ChamberBox.Text
    Dim lastRowI As Long
    lastRowI = AppendToColumn(Sheet1, "I", ORFibreBox.Text)
    AppendToColumn Sheet1, "K", ("=I" & lastRowI & "*5"), FormulaValue
End Sub

Private Function AppendToColumn(ByRef ws As Worksheet, _
                                ByVal columm As Variant, _
                                ByVal value As Variant, _
                                Optional ByVal kindOfValue As DataType = DataValue) As Long
    '--- copies the given value to the first empty cell in the
    '    specified column. the "columm" value can be either numeric
    '    or alphabetic. RETURNS the index of the last row
    Dim colIndex As Long
    Dim lastRow As Long
    Dim firstEmptyRow As Long
    With ws
        '--- quick conversion to make sure we have a numeric column index
        colIndex = IIf(IsNumeric(columm), columm, .Cells(1, columm).column)
        lastRow = .Cells(.Rows.Count, colIndex).End(xlUp).Row
        '--- if the column is completely empty, the first empty row is 1,
        '    otherwise it's one row down from the last row
        firstEmptyRow = IIf(IsEmpty(.Cells(lastRow, colIndex)), 1, lastRow + 1)
        Select Case kindOfValue
        Case DataValue
            .Cells(firstEmptyRow, colIndex).value = value
        Case FormulaValue
            .Cells(firstEmptyRow, colIndex).Formula = value
        End Select
    End With
    AppendToColumn = lastRow
End Function

Answer 2

Assuming that you always want the data from a single button press to fall on the same row, you can achieve this functionality with

let ws.[A1].Offset(row-1).Resize(1,10) = _  
        Array( _ 
            JobID.Text, _ 
            Surveyor.Text, _  
            DateBox.Text, _ 
            AddressBox.Text, _ 
            CityBox.Text, _ 
            PostcodeBox.Text, _ 
            THPBox.Text, _ 
            ChamberBox.Text, _ 
            ORFibreBox.Text)   
let ws.[K1].Offset(row-1).Formula="=I" & row & "*5"

where you have to row is found in the same way as you had been doing before, with some column that is garunteed not to have a blank. Or, if we assume that column J will always be blank at the time a new row is added, you can do this with

let ws.[A1].Offset(row-1).Resize(1,10) = _  
        Array( _ 
            JobID.Text, _ 
            Surveyor.Text, _  
            DateBox.Text, _ 
            AddressBox.Text, _ 
            CityBox.Text, _ 
            PostcodeBox.Text, _ 
            THPBox.Text, _ 
            ChamberBox.Text, _ 
            ORFibreBox.Text, _ 
            "", _  
            ("=I" & row & "*5"))

That said, you should probably look into making the table into a ListObject. If you do so (CTRL + T while highlighting the table; yes it has headers), you can make your code look like

dim lo as ListObject, _
    lr as ListRow

Set lo = ws.[A1].listobject
Set lr = lo.ListRows.Add
let lr.Range(1, 1).Resize(1, 11) = _ 
        Array( _ 
            JobID.Text, _ 
            Surveyor.Text, _  
            DateBox.Text, _ 
            AddressBox.Text, _ 
            CityBox.Text, _ 
            PostcodeBox.Text, _ 
            THPBox.Text, _ 
            ChamberBox.Text, _ 
            ORFibreBox.Text, _ 
            "", _  
            ("=I" & row & "*5"))

and, if you do end up doing this, you would probably want to change the way that the final formula is assigned to reflect Excel Table Reference notation

If you choose to do either of these ways, it will greatly reduce the number of updates that are made to the worksheet by pushing the entire row at once. This should make the method run significantly faster - thought I would expect this not to be very noticible with this relatively small number of columns.