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:

enter image description here

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.

• JED: I did the separation stuff you mentioned at the top and turned on the Option Explicit. I tidied my code a bit. I used On Error Resume Next because it was the fastest way to get rid of that error. The error is caused by there not being a table that uses the name of brand_edit (now brandTableName). This error will not occur once I edit the DATA page that has all the tables to include all the tables. So once I fix that I will get rid of the error handling for that. I am clearing the text of the ItemID combo box so when a brand_change occurs the selected item is cleared.
• JED: The point of the brand_change is to convert the brand name to a valid table name (aka a table range). cmbItemID then uses that table name to get its data.
• JED: Thanks for all these suggestions. They really helped make my code cleaner and more effective. I expect when I code the other parts of this excel sheet I will benefit from these changes.
• JED: Oh, and I will also look into Rubberduck. Thanks for the reference.

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/

• JED: Thank you for this suggestion. I took this and Zak's suggestion. I edited my original post with the new code.

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)

enter image description here

• JED: So in implementing this into my code, I ran into a few problems. I can't set brandTableName to "BrandTable" because brandTableName is = to the name of the selected brand's table. I need brandTableName to = what it does in my UserForm code. I also ran into a problem with dSheet not being recognized as a defined variable of my worksheet because it is defined as public in my userform code instead of in the module code. How do I fix this? Same thing with DataTable.