Userform for getting data from data sheet into a table

Question

I am making a userform that grabs data from a data sheet and puts it into a table:

1. Grabs the data based on what the user wants (Brand -> Items for brand)
2. Allows multiple items to be added
3. Displays the info about the items
4. Allows the user to specify how many of each item (for when the data is put into the inventory table)

I am just looking for any suggestions on how I could make my code better, specifically with error handling and lowering memory footprint. I am a novice, so some of this code could have better approaches. If so, please tell me.

UserForm:

ThisWorkBook:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.AutoCorrect.AutoFillFormulasInLists = True
End Sub

Private Sub Workbook_Open()
Application.AutoCorrect.AutoFillFormulasInLists = False
End Sub

Add Item Button:

Private Sub cbAddItemUserForm_Click()

ufItemAdd.Show

End Sub

UserForm:

Public brand_edit As Variant
Public cBook As Workbook
Public cSheet As Worksheet
Public dSheet As Worksheet
Public specLink As Variant
Public itemAddress As Variant
Public itemID As String
Public inventoryTable As ListObject
Public x As Long
Public quantity As String

Private Sub MultiPage1_Change()

End Sub

Private Sub UserForm_Activate()

Me.tbQuantity.Text = "1"

End Sub

Public Sub cmbBrand_Change()

Me.tbQuantity.Text = "1"

Dim brand As Variant
brand = cmbBrand.Value
brand_edit = Replace(brand, " ", "_")
brand_edit = Replace(brand_edit, """", "")
brand_edit = Replace(brand_edit, "-", "")
brand_edit = Replace(brand_edit, "(", "")
brand_edit = Replace(brand_edit, ")", "")
brand_edit = Replace(brand_edit, "&", "and")
brand_edit = Replace(brand_edit, ".", "")
brand_edit = Replace(brand_edit, ",", "")
brand_edit = Replace(brand_edit, ", ", "_")
brand_edit = Replace(brand_edit, "__", "_")
brand_edit = LCase(brand_edit)

'On Error Resume Next
'If brand_edit = "" Then
'    cmbItemID.RowSource = ""
'Else

On Error Resume Next

If Err = 380 Then
    Exit Sub
Else
cmbItemID.RowSource = brand_edit

End If

Err.Clear

On Error GoTo 0

cmbItemID.Text = ""


End Sub

Private Sub cmbItemID_Change()

Me.tbQuantity.Text = "1"

Dim brandTable As String
Dim i As Long
Dim dataTable As ListObject

Set cBook = ActiveWorkbook
Set cSheet = cBook.Sheets("Gen. Info")
Set dSheet = cBook.Sheets("DATA")

itemID = cmbItemID.Value
brandTable = brand_edit

On Error Resume Next
Set dataTable = dSheet.ListObjects(brand_edit)


For i = 1 To dataTable.ListRows.Count
    If dataTable.ListColumns(1).DataBodyRange.Rows(i) = itemID Then

    tbDescription.Text = dataTable.ListColumns(3).DataBodyRange.Rows(i).Value
    tbSpecs.Text = dataTable.ListColumns(4).DataBodyRange.Rows(i).Formula
    specLink = dataTable.ListColumns(4).DataBodyRange.Rows(i).Formula
    tbListPrice.Text = dataTable.ListColumns(5).DataBodyRange.Rows(i).Value
    tbCost.Text = dataTable.ListColumns(6).DataBodyRange.Rows(i).Value
    tbNotes.Text = dataTable.ListColumns(7).DataBodyRange.Rows(i).Value
    itemAddress = dataTable.ListColumns(1).DataBodyRange.Rows(i).Address
    tbAddress.Text = itemAddress
    Exit For

    Else
    End If

Next



End Sub
Private Sub cbSpecs_Click()
Dim specLink_edit As Variant
specLink_edit = Replace(specLink, "=HYPERLINK(", "")
specLink_edit = Replace(specLink_edit, ")", "")
specLink_edit = Replace(specLink_edit, ",", "")
specLink_edit = Replace(specLink_edit, """", "")
specLink_edit = Replace(specLink_edit, "Specs", "")
If specLink_edit = "" Then
    Exit Sub
Else
cBook.FollowHyperlink (specLink_edit)
End If

End Sub

Private Sub cbSubmit_Click()

Dim i As Long
Dim v As Variant
Dim vTable() As Variant

'add error handling here (if no cmbBrand change has occured, hitting submit will error)
 Set inventoryTable = cSheet.ListObjects("inventory_table")
    colItemID = inventoryTable.ListColumns("Item #").Index
    colSpecs = inventoryTable.ListColumns("Specs").Index
    colQty = inventoryTable.ListColumns("Qty").Index

    v = inventoryTable.DataBodyRange.Rows
    ReDim vTable(1 To UBound(v, 1), 1 To 5)
    For i = 0 To lbItemList.ListCount - 1

        vTable(i + 1, 1) = "=DATA!" & lbItemList.List(i, 2)
        vTable(i + 1, 5) = lbItemList.List(i, 3)

        If specLink = "" Then

        ElseIf specLink <> "" Then

            vTable(i + 1, 4) = lbItemList.List(i, 1)

        End If
    inventoryTable.ListColumns("Item #").DataBodyRange(i + 1, colItemID).Value = vTable(i + 1, 1)
    inventoryTable.ListColumns("Specs").DataBodyRange(i + 1).Value = vTable(i + 1, 4)
    inventoryTable.ListColumns("Qty").DataBodyRange(i + 1).Value = vTable(i + 1, 5)
    Next

Unload Me
End Sub
Private Sub cbAddItem_Click()
quantity = Me.tbQuantity.Text

If Me.lbItemList.ListCount = 0 Then
    x = 0
End If

With Me.lbItemList
    Me.lbItemList.ColumnCount = 4
    .AddItem
    .List(x, 0) = itemID
    .List(x, 1) = specLink
    .List(x, 2) = itemAddress
    .List(x, 3) = quantity
    x = x + 1

End With

End Sub

Private Sub cbRemoveItems_Click()

For intCount = lbItemList.ListCount - 1 To 0 Step -1
     If lbItemList.Selected(intCount) Then lbItemList.RemoveItem (intCount)
Next intCount


End Sub

Answer 1

Option Explicit

Go to Tools -> Options -> Require Variable Declaration. This will insert Option Explicit at the top of every new module you create. Option Explicit will enforce that every variable you use is declared. This will prevent all sorts of bugs, mainly due to preventing typos.

---

Separation of concerns

You should never have business logic contained directly in your event triggers. It means your code is scattered around, is not easily find-able, and is very tightly coupled with your form. You should separate out your logic into Sub/Functions which your event handlers can then call.

Take this for instance:

Public Sub cmbBrand_Change()

Me.tbQuantity.Text = "1"

Dim brand As Variant
brand = cmbBrand.Value
brand_edit = Replace(brand, " ", "_")
brand_edit = Replace(brand_edit, """", "")
brand_edit = Replace(brand_edit, "-", "")
brand_edit = Replace(brand_edit, "(", "")
brand_edit = Replace(brand_edit, ")", "")
brand_edit = Replace(brand_edit, "&", "and")
brand_edit = Replace(brand_edit, ".", "")
brand_edit = Replace(brand_edit, ",", "")
brand_edit = Replace(brand_edit, ", ", "_")
brand_edit = Replace(brand_edit, "__", "_")
brand_edit = LCase(brand_edit)

That whole brand_edit thing should be a Function. Maybe something called CleanBrandName which takes a brandName as an argument and returns a cleaned version:

Public Function CleanBrandName(ByVal brandName As String) As String

    Dim cleanName  As String
    cleanName = brandName

    cleanName = Replace(cleanName, " ", "_")
    cleanName = Replace(cleanName, ", ", "_")
    cleanName = Replace(cleanName, "__", "_")

    cleanName = Replace(cleanName, """", "")
    cleanName = Replace(cleanName, "-", "")
    cleanName = Replace(cleanName, "(", "")
    cleanName = Replace(cleanName, ")", "")
    cleanName = Replace(cleanName, ".", "")
    cleanName = Replace(cleanName, ",", "")

    cleanName = Replace(cleanName, "&", "and")

    cleanName = LCase(cleanName)


    CleanBrandName = cleanName

End Function

And now your cmbBrand_Change can just go:

Public Sub cmbBrand_Change()

Me.tbQuantity.Text = "1"

Dim brand As Variant
brand = cmbBrand.Value
brand = CleanBrandName(brand)

And when you find new cases that need to be handled by CleanBrandName you know where to find it and that you only need to change it in that one place. If you ever need to clean a brand name somewhere else in your code, you can just call that function rather than copy-pasting all the logic again.

---

Keep your code tidy and organised

'On Error Resume Next
'If brand_edit = "" Then
'    cmbItemID.RowSource = ""
'Else

On Error Resume Next

If Err = 380 Then
    Exit Sub
Else
cmbItemID.RowSource = brand_edit

End If

Err.Clear

On Error GoTo 0

cmbItemID.Text = ""

This is just a mess. Don't leave commented-out code in your codebase, get yourself some proper Source Control (I highly recommend RubberDuck which is an Add-In that provides, among other awesome things, Git Integration for the VBE).

---

On Error Resume Next is a very dangerous command that should be avoided wherever possible and, if not, then used under tightly-defined circumstances.

This is an appropriate way to use it:

itemValue = empty

'/ Will error if the key does not exist
On Error Resume Next
    itemValue = collection.Item(key)
On Error Goto 0

If not IsEmpty(itemValue) Then
    '/ Key Exists, Do Stuff
Else
    '/ Handle missing Key
End If

We have a statement which may cause an error, so we temporarily disable error handling for that statement, immediately re-enable it afterwards and immediately handle the error if it occurred. And we leave a comment explaining what error we were expecting and why we're doing things this way.

---

Back to your code, this is pointless:

On Error Resume Next

If Err = 380 Then
    Exit Sub
Else

If an error had already occurred before On Error... then the program would've stopped already and thrown an error message, so checking after the fact is not useful.

---

What on earth is this doing?

cmbItemID.RowSource = brand_edit

.RowSource is supposed to be used to set a valid Range Reference, like say "A10" or "NamedRange". How a brandName fits in to that is incredibly unclear.

---

Err.Clear

On Error GoTo 0

If you're expecting an error, then handle the error you're expecting. Don't just dismiss any error whatsoever. Errors are important. Errors are useful. Errors should not be ignored unless you can articulate precisely what you're ignoring and why.

---

cmbItemID.Text = ""


End Sub

And you're just clearing the box at the end of the sub anyway? So why on earth have this change event in the first place?

---

This is why explanatory comments are important. If your code is doing something, and the thing is not immediately obvious, you should leave a comment explaining what's going on and why.

Answer 2

Here is an afterthought on your cmbBrand_Change() event.

Function AdjustBrandValue(ByVal strChar As String) As String

Dim i As Integer
Dim strResult As String

For i = 1 To Len(strChar)
    Select Case Asc(Mid(strChar, i, 1))
        Case 32, 48 To 57, 65 To 90, 97 To 122:
            strResult = strResult & Mid(strChar, i, 1)
        Case 95
            strResult = strResult & " "
        Case 38
            strResult = strResult & "and"
    End Select
Next i
AdjustBrandValue = Replace(WorksheetFunction.Trim(strResult), " ", "_")

End Function

Then call the Function as Zak noted above:

Public Sub cmbBrand_Change()    

Dim brand As Variant
brand = AdjustBrandValue(cmbBrand.Value)

End Sub

This will examine the Ascii value for each character in the string and keep only alphanumeric values. It will also change the _ to (space) and the & to "and". Then it will trim the string and replace the spaces with _. It helps by your not having to account for every possible scenario (i.e. ,(space) or __ or some other non-alphanumeric character).

Here is the Ascii Table: http://www.asciitable.com/

Answer 3

CleanSpecHyperlink returns an empty string.

Change

cleanSpecLink = cleanLink

To

CleanSpecHyperlink = cleanLink

brandTableName is a const and belongs in a Public code module.

Sub cmbItemID_Change: Modifications

• Iterate Each Row in datatable
• Group all variable assignments together
• Remove On Error Resume Next
• itemAddress and tbAddress.Text refer to the same value. Is itemAddress needed?

This works fine but is not very flexible:

tbDescription.Text = dataTable.ListColumns(3).DataBodyRange.Rows(i).Value

A better way is to use an enumeration and function in a public module to give you a cell reference. This way you can easily update your code if you have to add, remove or rearrange columns in your table.

In a public module:

Option Explicit
Public Enum BrandColumn
    bcItemAddress = 1
    bcDescription = 3
    bcSpecs
    bcSpecLink
    bcListPrice
    bcNotes
    bcCost
End Enum


Dim brandTable As String
Dim datatable As ListObject
Dim r As Range

Set datatable = dSheet.ListObjects(brand_edit)

For Each r In datatable.DataBodyRange.Rows

    If r.Columns(bcItemAddress) = cmbItemID.Value Then
        tbDescription.Text = r.Columns(bcDescription).Value
        tbSpecs.Text = r.Columns(bcSpecs).Formula
        specLink = r.Columns(bcSpecLink).Formula
        tbListPrice.Text = r.Columns(bcListPrice).Value
        tbCost.Text = r.Columns(bcCost).Value
        tbNotes.Text = r.Columns(bcNotes).Value
        itemAddress = r.Columns(bc).Address
        tbAddress.Text = itemAddress
        Me.tbQuantity.Text = "1"
        Exit For
    End If

Next

This is much easier to read, debug, and modify. (Enumeration Reference)