Something strange is happening where I call a userform to show via a module, but it says object is required and does not initialize the form. The strange part is the method of calling does not change from a workbook that functions the exact same.
I have a module with the following code assigned to a button:
Sub SHOW_INSERT_TASK_FORM()
INSERT_TASK_FORM.Show ' Error Occurs here
End Sub
This should initialize the "INSERT_TASK_FORM" user form and run its code but I receive an object required error upon the "Show" method.
Here is the code imbedded within the user form:
Private Sub SUBMIT_BUTTON_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
'DECLARE OBJECT VARIABLES
Dim planner_ws As Worksheet, data_ws As Worksheet
Dim departments As ListObject
Dim types As ListObject
Dim tasks As ListObject
Dim dep_arr() As Variant
Dim type_arr() As Variant
Dim task_arr() As Variant
Dim i As Double, j As Double, x As Double
Dim lrow As Double, srow As Double
'SET WS VARIABLES
Set planner_ws = ThisWorkbook.Worksheets("TASK_PLANNER")
Set data_ws = ThisWorkbook.Worksheets("DATA")
'ASSIGN OBJECT VARIABLES
Set departments = data_ws.ListObjects("DEPARTMENT_TABLE")
Set types = data_ws.ListObjects("TASK_TYPE_TABLE")
Set tasks = data_ws.ListObjects("TASKS_TABLE")
'ASSIGN VARIABLE VALUES
dep_arr = departments.DataBodyRange
type_arr = types.DataBodyRange
task_arr = tasks.DataBodyRange
lrow = planner_ws.Cells(planner_ws.Rows.Count, 2).End(xlUp).Row
'INITIAL USER FORM VALUES
TASK_NAME_TBOX.Value = ""
DESC_TBOX.Value = ""
SDATE_TBOX.Value = ""
EDATE_TBOX.Value = ""
Task_Option = False
Sub_Option = False
'POPULATE COMBO BOXES
With TYPE_CBOX
For i = LBound(type_arr) To UBound(type_arr)
.AddItem type_arr(i, types.ListColumns("Task_Type").Index)
Next i
End With
With DEP_CBOX
For i = LBound(dep_arr) To UBound(dep_arr)
.AddItem dep_arr(i, types.ListColumns("Department").Index)
Next i
End With
With TASK_CBOX
For i = LBound(task_arr) To UBound(task_arr)
.AddItem task_arr(i, types.ListColumns("Task Name").Index)
Next i
End With
End Sub
Private Sub SUB_OPTION_Click()
If Sub_Option.Value = True Then
Task_Label.Visible = True
TASK_CBOX.Visible = True
Else
Task_Label.Visible = False
TASK_CBOX.Visible = False
End If
End Sub
For reference, the following code in another workbook of mine works just fine:
Sub GameSale_Form()
xInput_GameSale.Show
End Sub
Private Sub UserForm_Initialize()
LCS_Option = False
NOTLCS_Option = False
Qty_TextBox.Value = ""
Discount_TextBox.Value = ""
InputCost_Textbox.Value = ""
InRegion_Option.Value = False
NotInRegion_Option = False
New_Option.Value = False
Used_Option.Value = False
InputCost_Option = False
AvCost_Option = False
FDAPricing_Option = False
NoFDAPricing_Option = False
With Cabinet_Combobox
For i = 2 To ThisWorkbook.Worksheets("List_Data").Cells(Rows.Count, 36).End(xlUp).Row
.AddItem ThisWorkbook.Worksheets("List_Data").Cells(i, 36).Value
Next i
End With
Opening_Textbox.Value = ""
Ambition_Textbox.Value = ""
Goal_Textbox.Value = ""
WalkAway_Textbox.Value = ""
Qty_SpinButton.Min = 0
Qty_SpinButton.Max = 1000
End Sub
Related
I have two groups of radio buttons. see below image.
where one group for transaction type and another for transaction number.
total 6 transactions are allowed in a day. where 3 for withdrawals and other three for deposits.
I am using below vba code to auto select next radio button if one is
used. but no luck.
Sub OBWithdrawal_Click()
Dim OBWithdrawal, OBDeposit, OB1st, OB2nd, OB3rd As OptionButton
'transaction type
Set OBWithdrawal = Sheet1.Shapes("OBWithdrawal").OLEFormat.Object
Set OBDeposit = Sheet1.Shapes("OBDeposit").OLEFormat.Object
'transaction number
Set OB1st = Sheet1.Shapes("OB1st").OLEFormat.Object
Set OB2nd = Sheet1.Shapes("OB2nd").OLEFormat.Object
Set OB3rd = Sheet1.Shapes("OB3rd").OLEFormat.Object
If Sheet1.Range("G24").Value = "#NUM" Then
OB1st.Value = True
If Sheet1.Range("G24").Value = 1 Then
OB2nd.Value = True
If Sheet1.Range("G24").Value = 2 Then
OB3rd.Value = True
If Sheet1.Range("G24").Value = 3 Then
OB1st.Value = False
OB2nd.Value = False
OB3rd.Value = False
MsgBox "You have only 3 withdrawal are allowed in a single day." & vbNewLine & ""
End If
End If
End If
End If
End Sub
I did not received any error messages. so I cant figure out where I m doing wrong.
please help
1. Always declare variables separately. If you declare them as Dim OBWithdrawal, OBDeposit, OB1st, OB2nd, OB3rd As OptionButton, then only the last one which is OB3rd will be declared as OptionButton. Rest will be declared as Variant
2. You can use a single IF-ELSEIF-ENDIF statement to handle all those criteria.
3. This procedure is for Withdrawal. Similarly, create for Deposit. Alternatively, you can create a common procedure for both and then use Application.Caller to identify which is the "calling" option button and then execute the relevant code.
Is this what you are trying?
Option Explicit
Sub OBWithdrawal_Click()
Dim OBWithdrawal As OptionButton
Dim OB1st As OptionButton
Dim OB2nd As OptionButton
Dim OB3rd As OptionButton
Set OBWithdrawal = Sheet1.Shapes("OBWithdrawal").OLEFormat.Object
With Sheet1
Set OB1st = .Shapes("OB1st").OLEFormat.Object
Set OB2nd = .Shapes("OB2nd").OLEFormat.Object
Set OB3rd = .Shapes("OB3rd").OLEFormat.Object
If .Range("G24").Value = "#NUM" Then
OB1st.Value = True
ElseIf .Range("G24").Value = 1 Then
OB2nd.Value = True
ElseIf .Range("G24").Value = 2 Then
OB3rd.Value = True
ElseIf .Range("G24").Value = 3 Then
OB1st.Value = False
OB2nd.Value = False
OB3rd.Value = False
MsgBox "You have only 3 withdrawal are allowed in a single day." & vbNewLine & ""
End If
End With
End Sub
EDIT
This is the 3rd way that I was talking about. Assign this code to both the Withdrawal and Deposit button. This will work for both.
Option Explicit
Sub OBWithdrawalDeposit_Click()
Dim OptBtn As OptionButton
Dim OB1st As OptionButton
Dim OB2nd As OptionButton
Dim OB3rd As OptionButton
Dim OptBtnName As String
Dim TrnType As String
OptBtnName = Application.Caller
'~~> If Withdrawal was selected
If OptBtnName = "OBWithdrawal" Then
Set OptBtn = Sheet1.Shapes("OBWithdrawal").OLEFormat.Object
TrnType = "Withdrawals"
ElseIf OptBtnName = "OBDeposit" Then '<~~ If Deposit was selected
Set OptBtn = Sheet1.Shapes("OBDeposit").OLEFormat.Object
TrnType = "Deposits"
Else
MsgBox "This procedure was not called the right way"
Exit Sub
End If
With Sheet1
Set OB1st = .Shapes("OB1st").OLEFormat.Object
Set OB2nd = .Shapes("OB2nd").OLEFormat.Object
Set OB3rd = .Shapes("OB3rd").OLEFormat.Object
If .Range("G24").Value = "#NUM" Then
OB1st.Value = True
ElseIf .Range("G24").Value = 1 Then
OB2nd.Value = True
ElseIf .Range("G24").Value = 2 Then
OB3rd.Value = True
ElseIf .Range("G24").Value = 3 Then
OB1st.Value = False
OB2nd.Value = False
OB3rd.Value = False
MsgBox "You are allowed only 3 " & TrnType & " in a single day."
End If
End With
End Sub
This macro copies Excel worksheets that have a numeric name to another Excel workbook.
For example only worksheets that are titled with 6 digits. For Example "140655".
I want to also copy over the worksheets that have a standard English name such as "Budget".
Const CalcDelay = 0.00000578704
Dim CopyRange As String
Dim PasteRange As String
Dim ScanFileOpen As Byte
Dim ScanCount As Byte
Dim ScanSaveSpec As String
Dim ScanSaveFile As String
Dim ReturnWindow As String
Dim ReportFile As String
Dim ExcelVersion As String
Sub OpenReportFile()
ReturnWindow = [ProcessWinSpec].Value
If [ReportFileFlag].Value = True Then
Application.ScreenUpdating = False
Workbooks.Open Filename:=[ReportFileSpec].Value
Windows(ReturnWindow).Activate
Application.ScreenUpdating = True
Else
MsgBox ("Error: File not found")
End If
End Sub
Sub DoScan()
Dim Work As Variant
Dim X As Interger
ReturnWindow = [ProcessWinSpec].Value
ReportFile = [ReportFileName].Value
ExcelVersion = IIf([FileNameExt].Value = ".xls", 2003, 2013)
For Each Work In [ScanFlags]
ScanFileOpen = 0
ScanCount = 0
If Work.Value = 1 Then
[ScanName].Value = Work.Offset(0, 1).Value
[ScanCalcRange].Calculate
ScanSaveFile = [ScanFile].Value
ScanSaveSpec = [ScanSpec].Value
For X = Work.Offset(0, 2).Value To 1 Step -1
ScanTabName = Work.Offset(0, X + 2).Value
[ScanTab].Value = ScanTabName
[ScanCalcRange].Calculate
If [ReadFlag].Value = 1 Then DoCopyTab
Next
End If
If ScanFileOpen = 1 Then
ActiveWorkbook.Save
ActiveWindow.Close
End If
Next
End Sub
With regards to your question on how to excecute a macro if files have a certain name, probably the best approach would be to create an array of words, and then loop through them seeking a match. See example with your code:
Sub OpenReportFile()
Const yourWords = "budget,actual,accept" '<--- fill these in separated by comman
ReturnWindow = [ProcessWinSpec].Value
Dim foundMatch As Boolean
If [ReportFileFlag].Value = True Then
foundMatch = True
Else
Dim wordArray() As String, i As Long
wordArray = Split(yourWords, ",")
'loopS through words
For i = LBound(wordArray) To UBound(wordArray)
If UCase(wordArray(i)) = UCase([ReportFileFlag].Value) Then
foundMatch = True
Exit For 'exits loop after match
End If
Next i
End If
If foundMatch Then
Application.ScreenUpdating = False
Workbooks.Open Filename:=[ReportFileSpec].Value
Windows(ReturnWindow).Activate
Application.ScreenUpdating = True
Else
MsgBox ("Error: File not found")
End If
End Sub
As you can see in the comments, your question isn't receiving the most favorable feedback as far as clarity. If this doesn't work, you may want to consider eleting your question and reposting after more carefully reviewing How to ask a question
I have a userform that is pulling in data from a worksheet into the userform fields. I have a function that matches the row of that employee if the employee number in userform is found in column F.
It used to work but now it doesn't even enter the function to determine if that employee exists in the data.
Private Sub CommandButton2_Click()
On Error Resume Next
Dim wb As Workbook: Set wb = Workbooks.Open("J:\HRIS Team\Analytics\Headcount Tracking File.xlsx")
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
Dim lString As String, lArray() As String
lString = cmbEmployee.Value
lArray = Split(lString, " - ")
Dim recRow As Range
If optEmployeeName.Value = True And optEmployeeID.Value <> True Then
Set recRow = MatchRow(ws.Range("A1").CurrentRegion, _
lArray(1))
Else
Set recRow = MatchRow(ws.Range("A1").CurrentRegion, _
lArray(0))
End If
If recRow Is Nothing Then MsgBox "Employee not found"
With recRow.EntireRow
Me.cmbFunction.Value = .Cells(1).Value
Me.cmbHRBP.Value = .Cells(3).Value
Me.cmbRequestType.Value = .Cells(4).Value
Me.cmbMovementType.Value = .Cells(7).Value
Me.txtEffectiveDate.Value = .Cells(8).Value
Function MatchRow(tablerange As Range, lArray) As Range
Dim rw As Range
Dim lString_2 As String, lArray_2() As String
lString_2 = cmbEmployee.Value
lArray_2 = Split(lString_2, " - ")
For Each rw In tablerange.Rows
If optEmployeeName.Value = True Then
If CStr(rw.Cells(6).Value) = Trim(lArray_2(1)) Then
Set MatchRow = rw
Exit Function
End If
ElseIf optEmployeeID.Value = True Then
If CStr(rw.Cells(6).Value) = Trim(lArray_2(0)) Then
Set MatchRow = rw
Exit Function
End If
End If
Next rw
End Function
I hover over to make sure it's getting the employee ID correctly from the lArray, and its there. I can't figure out the reasoning behind why it wouldn't even attempt to enter the matchrow function. Any ideas?
I am using the following to hide and unhide some rows, but I want to use a shape - "RectangleRoundedCorners9" - instead of the ugly button. The script works great on a button (does exactly what I want it to) but only on an actual button.
I don't know VBA and am not sure how to get this code to work with that shape instead of a button:
Private Sub ToggleButton1_Click()
Dim xAddress As String
xAddress = "F:G"
If ToggleButton1.Value Then
Application.ActiveSheet.Columns(xAddress).Hidden = True
Else
Application.ActiveSheet.Columns(xAddress).Hidden = False
End If
End Sub
I tried replacing as follows but get a 424 "Object not found" error on the IF line:
Private Sub RectangleRoundedCorners9_Click()
Dim xAddress As String
xAddress = "F:G"
If RectangleRoundedCorners9.Value Then
Application.ActiveSheet.Columns(xAddress).Hidden = True
Else
Application.ActiveSheet.Columns(xAddress).Hidden = False
End If
End Sub
Thanks in advance.
BONUS: I'd like to inject the final product into the following to get the shape to visual behave like a button as well:
Sub SimulateButtonClick()
Dim vTopType As Variant
Dim iTopInset As Integer
Dim iTopDepth As Integer
With ActiveSheet.Shapes(Application.Caller).ThreeD
vTopType = .BevelTopType
iTopInset = .BevelTopInset
iTopDepth = .BevelTopDepth
End With
With ActiveSheet.Shapes(Application.Caller).ThreeD
.BevelTopType = msoBevelSoftRound
.BevelTopInset = 12
.BevelTopDepth = 4
End With
Application.ScreenUpdating = True
With ActiveSheet.Shapes(Application.Caller).ThreeD
.BevelTopType = vTopType
.BevelTopInset = iTopInset
.BevelTopDepth = iTopDepth
End With
'---------------
'HIDE/UNHIDE SCRIPT HERE
'---------------
End Sub
Something like this:
Sub ToggleCols()
Const RNG As String = "F:G"
Dim s, tr
Set s = ActiveSheet.Shapes(Application.Caller)
Set tr = s.TextFrame2.TextRange
ActiveSheet.Columns(RNG).Hidden = (tr.Text = "Hide")
tr.Text = IIf(tr.Text = "Hide", "Show", "Hide")
End Sub
I have to generate hundreds of form control dropdowns with same item values. So i would like to clone them if possible. And i should be able to change few attributes like Name, OnAction Any ideas would be appreciated greatly.
Sub Macro1()
Dim c As Range, i As Long, nm As String
Dim sht As Worksheet
Set sht = ActiveSheet
i = 0
For Each c In sht.Range("A2:A20")
i = i + 1
nm = "dd_" & i
On Error Resume Next
sht.Shapes(nm).Delete
On Error GoTo 0
With sht.DropDowns.Add(c.Left, c.Top, c.Width, c.Height)
.Name = nm
.ListFillRange = "K1:K6"
.LinkedCell = ""
.DropDownLines = 8
.Display3DShading = False
.OnAction = "HandleClick"
End With
Next c
End Sub
Handler:
Sub HandleClick()
Debug.Print Application.Caller
End Sub