Loop through single column of Userform - vba

I've worked with userforms in VBA a bit and know some of the tricks for looping through all controls. However, I'm running into issues with this one, and need a way to read the values of the line and reason columns into arrays based upon the values of "Area" and "Shift". The possible values for these two columns are in the picture.
Basically what I need is something like
For Each ctl In Me.Controls
If somectl.Value = "Kitting" And otherctl.Value = "1" Then
ReDim Preserve somearray(i)
somearray(i) = ctl.Value
End If
Next ctl

If you've manage to standardized your naming, you can do it like this:
Private Sub CommandButton1_Click()
Dim i As Integer
Dim areaCB As MSForms.ComboBox
Dim shiftCB As MSForms.ComboBox
Dim reasonCB As MSForms.ComboBox
Dim somearray
For i = 1 To 3 ' 3 or more depending on how may you have in your form
Set areaCB = Me.Controls("areadd" & i)
Set shiftCB = Me.Controls("shiftdd" & i)
Set reasonCB = Me.Controls("reasondd" & i)
If areaCB.Value = "Kitting" _
And shiftCB.Value = "1" Then
If IsArray(somearray) Then
ReDim Preserve somearray(UBound(somearray) + 1)
somearray(UBound(somearray)) = reasonCB.Value
Else
somearray = Array(reasonCB.Value)
End If
End If
Next
End Sub
So for example in areadd1, 1 is the row number.
Correspondingly, the ComboBox next to it to the right is shiftdd1 and so on.
This is just to give you idea. Modify it to suit your needs.

Related

VBA Userform: Update Total value in a label with multiple inputs, when entries change, by using a class module

I have a userform with 120 textboxes (10 years x 12 months). Going across are the months, and at the end is the total.
This is repeated 10 times for the 10 years going downwards
I would like it so the total label is updated when the values for the corresponding years' months change.
Textboxes are labelled for each year and month. The first one is 'TextBox1_1', the second is 'TextBox1_2'. for the third year, and fifth month it is 'TextBox3_5' and so forth.
I have a module which is set up to calculate the totals:
Sub totalVal(i As Integer)
Dim arr(1 To 12) As Integer
Dim j As Integer
For j = 1 To 12
If Trim(Basic_Info_Setup.Controls("TextBox" & i & "_" & j).Value & vbNullString) = vbNullString Then
Else
arr(j) = Basic_Info_Setup.Controls("TextBox" & i & "_" & j).Value
End If
Next j
Basic_Info_Setup.Year1_Total.Caption = Application.WorksheetFunction.Sum(arr)
End Sub
The 'i' will be passed as the year and the rest can be calculated. However to use this would a change event in all 120 textboxes which is far from ideal, but not undoable.
I have read and understand this is possible with a class module.
This one which shows how to do it with textboxes (Here) and I also had a look at how this one (Here) albeit it confused me more than it helped.
What do I need to do to make this class module for me?
I currently have in the class module, which is called 'clsLabel'
Private WithEvents MyTextBox As MSForms.TextBox
Public Property Set Control(tb As MSForms.TextBox)
Set MyTextBox = tb
End Property
Private Sub MyTextBox_Change()
totalVal (1)
End Sub
and in the userform
Private Sub UserForm_Initialize()
Dim tbCollection As Collection
Dim ctrl As MSForms.Control
Dim obj As clsLabel
Set tbCollection = New Collection
For Each ctrl In Me.Controls
If TypeOf ctrl Is MSForms.TextBoxThen
Set obj = New clsLabel
Set obj.Control = ctrl
tbCollection.Add obj
End If
Next ctrl
Set obj = Nothing
End Sub
when things work I would be happy to change the passing 'i' integer to be dynamic, I just have it set at 1 for now to see if it works for a specific year
There are no errors.
EDIT: corrections to above code as it now works
thanks

VBA: Couldn't find names of textboxes created by control.add loop

I created textboxes with control.add loop but I couldn't change their values. I want their names tb1, tb2...
Private Sub UserForm_Initialize()
For i = 1 To 10
Dim cCntrl As Control
Set cCntrl = Me.Controls.Add("Forms.textbox.1", "tb" & i)
Next
tb4 = "b"
End Sub
You cannot access the controls via name as the compiler doesn't know about these names. Instead, you can assign the controls to an array. Probably you want to access the controls not only at Initializing, so declare it as global.
Option Explicit
Dim ctrlArr(1 To 10) As Control, i As Long
Private Sub UserForm_Initialize()
For i = 1 To 10
Set ctrlArr(i) = Me.Controls.Add("Forms.textbox.1", "tb" & i)
ctrlArr(i).Top = i * 20
Next
ctrlArr(4).value = "b"
End Sub

How do you add multiple values into a array using for loops?

(For future reference) Is it possible do something like this
For i = 0 to 11
array(i) = Label(i)
Next
Instead of brute forcing it by making 12 lines of something like
array(0) = Label0, array(1) = Label1, etc.
yes it is
for instance
Private Sub CommandButton1_Click()
ReDim myArray(0 To Me.Controls.count - 1) As MSForms.Label '<~~ declare this array with the maximum possible dimensions
Dim lblCounter As Long
Dim ctrl As MSForms.Control
With Me '<~~ this refers to the UserForm object of which code pane you placed this code into
For Each ctrl In .Controls '<~~ loop through UserForm controls
If TypeName(ctrl) = "Label" Then '<~~ if you find a "Label"...
Set myArray(lblCounter) = ctrl '<~~ ... then store it in your array...
lblCount = lblCounter + 1 '<~~ ... and update the label counter
End If
Next ctrl
End With
If lblCounter > 0 Then ReDim Preserve myArray(0 To lblCounter - 1) '<~~ if you actually found at least one label, then redim your array with proper dimensions
End Sub
of course you can place it in any event sub/eventhandler that has access to your Userform Controls collection

Type mismatch error in VBA when adding data to textbox

I have a TextBox and a ListBox with a list of various cities being populated from an Excel file
Now each city has one of two options: either within territory or outside. I want that option to be shown in textBox
I tried something like this :
Private Sub CommandButton1_Click()
TextBox2.Value = Application.VLookup(Me.ListBox1.Text,Sheets("Sheet1").Range("B:C"), 2, False)
End Sub
But am getting error stating that :
Run Time Error 2147352571 (80020005) . Could not set Value property. Type mismatch.
My excel file is something like this :
Let say your data are stored in Sheet1. You want to bind these data to ListBox1 on UserForm. I'd suggest to use custom function to load data instead of binding data via using RowSource property. In this case i'd suggest to use Dictionary to avoid duplicates.
See:
Private Sub UserForm_Initialize()
Dim d As Dictionary
Dim aKey As Variant
Set d = GetDistinctCitiesAndTerritories
For Each aKey In d.Keys
With Me.ListBox1
.AddItem ""
.Column(0, .ListCount - 1) = aKey
.Column(1, .ListCount - 1) = d.Item(aKey)
End With
Next
End Sub
'needs reference to Microsoft Scripting Runtime!
Function GetDistinctCitiesAndTerritories() As Dictionary
Dim wsh As Worksheet
Dim dict As Dictionary
Dim i As Integer
Set wsh = ThisWorkbook.Worksheets("Sheet1")
Set dict = New Dictionary
i = 2
Do While wsh.Range("A" & i) <> ""
If Not dict.Exists(wsh.Range("B" & i)) Then dict.Add wsh.Range("B" & i), wsh.Range("C" & i)
i = i + 1
Loop
Set GetDistinctCitiesAndTerritories = dict
End Function
After that, when user clicks on ListBox, city and territory are displayed in corresponding textboxes.
Private Sub ListBox1_Click()
Me.TextBoxCity = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
Me.TextBoxTerritory = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
End Sub
Note: code was written straight from the head, so it can contains errors!
The problem is likely that you aren't checking to see to see if the call to Application.VLookup succeeded. Most values returned can be successfully cast to a String - with one important exception: If the VLookup returns an error, for example it doesn't find Me.ListBox1.Text - it can't cast the Variant returned directly.
This should demonstrate:
Private Sub ReturnsOfVLookup()
Dim works As Variant, doesnt As String
works = Application.VLookup("Something not found", _
Sheets("Sheet1").Range("B:C"), 2, False)
Debug.Print works
On Error Resume Next
doesnt = Application.VLookup("Something not found", _
Sheets("Sheet1").Range("B:C"), 2, False)
If Err.Number <> 0 Then
Debug.Print Err.Description
Else
Debug.Print doesnt 'We won't be going here... ;-)
End If
End Sub

Scripting.Dictionary keys to Listbox VBA Excel

I have been working with VBA in excel and recently began working with the Scripting.Dictionary object. I hadn't run across any major problems until today.
Basically I am trying to populate a listbox with the Key values of a dictionary, then add one more value to the listbox. This results in the value not only being added to the listbox, but also to the dictionary as a key. I have attempted to copy the values from the dict.keys() array to a completely separate array, but still have the same issue. I assume this is a byref problem but have yet to figure out a solution. If anyone has any ideas that would be awesome.
Private Sub Setup_settingLst()
'Set Settings listbox items
'On Error GoTo ErrorExit
Dim list_ary() As Variant
Dim tmp As Variant
Dim i As Integer
settingLst.Clear
settingLst.Value = "-Select Setting-"
i = 0
tmp = tmp_dict.Keys()
If tmp_dict.Count > 1 Then
ReDim list_ary(0 To tmp_dict.Count)
For i = 0 To UBound(tmp)
list_ary(i) = tmp(i)
Next i
list_ary(tmp_dict.Count) = "Back"
Else
ReDim list_ary(0 To tmp_dict.Count - 1)
For i = 0 To UBound(tmp)
list_ary(i) = tmp(i)
Next i
End If
settingLst.List = list_ary
Erase list_ary
Exit Sub
ErrorExit:
End Sub
This seems to work
Private Sub UserForm_Click()
Dim dcValues As Scripting.Dictionary
Me.ListBox1.Clear
Set dcValues = FillDictionary
Me.ListBox1.List = dcValues.Keys
Me.ListBox1.AddItem "Back"
End Sub