C_Rieker
New Member
- Joined
- Nov 22, 2020
- Messages
- 16
- Office Version
- 365
- Platform
- Windows
Hello my favourite experts.
I am attempting to run a sub-routine every time a UserForm is initialised. The sub is used to format and position the UserForm elements based on values within a spreadsheet table. The code I use runs exceptionally well if I run it within the UserForm itself. However, my problem is that the code is quite repetitive, and I would rather not have to copy it into every UserForm coding (especially if I have to make a minor change to the code to all the UserForms.
To avoid the repetitive copy-paste, I have put the code into a Sub-Routine, and I pass the UserForm to the Sub as a variable. Only it stops and tells me Runtime Error: 13 - Type-Mismatch.
Any help would be greatly appreciated. Please see below my coding:
My UserForm Code:
My Sub-Routine:
The Error:
I am attempting to run a sub-routine every time a UserForm is initialised. The sub is used to format and position the UserForm elements based on values within a spreadsheet table. The code I use runs exceptionally well if I run it within the UserForm itself. However, my problem is that the code is quite repetitive, and I would rather not have to copy it into every UserForm coding (especially if I have to make a minor change to the code to all the UserForms.
To avoid the repetitive copy-paste, I have put the code into a Sub-Routine, and I pass the UserForm to the Sub as a variable. Only it stops and tells me Runtime Error: 13 - Type-Mismatch.
Any help would be greatly appreciated. Please see below my coding:
My UserForm Code:
VBA Code:
Private Sub UserForm_Initialize()
InitiateUserForm (UF_NewProduct)
End Sub
My Sub-Routine:
VBA Code:
Sub InitiateUserForm(UFName As UserForm)
Dim Table As Object
Dim ItemName As String
Dim cntrl As Control
Dim UFString As String
UFString = Right(UFName.Name, Len(UFName.Name) - 3)
Set Table = Sheets("UF LAYOUT").ListObjects("UFLayout_" & UFString)
With UFName
On Error Resume Next
ItemName = .Name
.Caption = WorksheetFunction.XLookup(ItemName, Table.ListColumns("Name").DataBodyRange, Table.ListColumns("Caption").DataBodyRange).Value
.Top = WorksheetFunction.XLookup(ItemName, Table.ListColumns("Name").DataBodyRange, Table.ListColumns("Top").DataBodyRange).Value
.Left = WorksheetFunction.XLookup(ItemName, Table.ListColumns("Name").DataBodyRange, Table.ListColumns("Left").DataBodyRange).Value
.Height = WorksheetFunction.XLookup(ItemName, Table.ListColumns("Name").DataBodyRange, Table.ListColumns("Height").DataBodyRange).Value
.Width = WorksheetFunction.XLookup(ItemName, Table.ListColumns("Name").DataBodyRange, Table.ListColumns("Width").DataBodyRange).Value
On Error GoTo 0
End With
For Each cntrl In UFName.Controls
On Error Resume Next
ItemName = cntrl.Name
cntrl.Caption = WorksheetFunction.XLookup(ItemName, Table.ListColumns("Name").DataBodyRange, Table.ListColumns("Caption").DataBodyRange).Value
cntrl.Top = WorksheetFunction.XLookup(ItemName, Table.ListColumns("Name").DataBodyRange, Table.ListColumns("Top").DataBodyRange).Value
cntrl.Left = WorksheetFunction.XLookup(ItemName, Table.ListColumns("Name").DataBodyRange, Table.ListColumns("Left").DataBodyRange).Value
cntrl.Height = WorksheetFunction.XLookup(ItemName, Table.ListColumns("Name").DataBodyRange, Table.ListColumns("Height").DataBodyRange).Value
cntrl.Width = WorksheetFunction.XLookup(ItemName, Table.ListColumns("Name").DataBodyRange, Table.ListColumns("Width").DataBodyRange).Value
cntrl.Visible = WorksheetFunction.XLookup(ItemName, Table.ListColumns("Name").DataBodyRange, Table.ListColumns("Visible").DataBodyRange).Value
On Error GoTo 0
Next cntrl
End Sub
The Error: