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
Related
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
I am trying to use VBA to loop through and find all dates within a textbox, regardless of format. I think I have my regex working. However, when trying to populate a combo box I am having difficulty.
Maybe my code is a bit messy and I am doing it the wrong way. Wha What I mean by that is it's putting every word in the combo box instead of just dates.
However, here is my code
Private Sub CommandButton2_Click()
Call dates1
End Sub
Function ExtractDates(S As String)
With CreateObject("VBScript.RegExp")
.Pattern = .Pattern = "^(?:(?:31(\/|-|\.)(?:0?[13578]|1[02]))\1|(?:(?:29|30)(\/|-|\.)(?:0?[13-9]|1[0-2])\2))(?:(?:1[6-9]|[2-9]\d)?\d{2})$|^(?:29(\/|-|\.)0?2\3(?:(?:(?:1[6-9]|[2-9]\d)?(?:0[48]|[2468][048]|[13579][26])|(?:(?:16|[2468][048]|[3579][26])00))))$|^(?:0?[1-9]|1\d|2[0-8])(\/|-|\.)(?:(?:0?[1-9])|(?:1[0-2]))\4(?:(?:1[6-9]|[2-9]\d)?\d{2})$"
.Global = True
ExtractDates = Replace(Trim(.Replace(S, " $1")), " ", ", ")
End With
End Function
Sub dates1()
Dim dates1 As String
Dim dates2 As String
dates2 = ExtractDates(Me.txtS.Text)
Dim optarray
Dim opt
optarray = Split(dates2, ",")
With Me.ComboBox1
.Clear
For opt = 0 To UBound(optarray)
.AddItem (optarray(opt))
Next opt
End With
End Sub
I managed to do this if anyone else is interested:
Option Explicit
Private Sub CommandButton1_Click()
CountDates (Me.TextBox1.Text)
End Sub
Function CountDates(S As String) As Long
Dim i As Integer
Dim result As String
Dim RE As Object, MC As Object
Const sPat As String = "\b(?:\d{1,2}/){2}(?:\d{4}|\d{2})\b"
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = sPat
.Global = True
Set MC = .Execute(S)
CountDates = MC.Count
CountDates = CountDates - 1
If MC.Count <> 0 Then
For i = 0 To CountDates
Me.ComboBox1.AddItem (MC.Item(i))
Next i
End If
End With
End Function
enter image description hereI have a spreadsheet that has 3 checkbox options for each row, I have created a VBA to disable the other 2 checkboxes once a checkbox is created (so that only 1 checkbox can be checked), however my solution only works for one row and I need some help in rewriting this so that it will apply to all rows please. (I'm new to VBA).
The code I have used is this:
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
CheckBox2.Value = False
CheckBox2.Enabled = False
CheckBox3.Value = False
CheckBox3.Enabled = False
Else
CheckBox2.Value = False
CheckBox2.Enabled = True
CheckBox3.Value = False
CheckBox3.Enabled = True
End If
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
CheckBox1.Value = False
CheckBox1.Enabled = False
CheckBox3.Value = False
CheckBox3.Enabled = False
Else
CheckBox1.Value = False
CheckBox1.Enabled = True
CheckBox3.Value = False
CheckBox3.Enabled = True
End If
End Sub
Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then
CheckBox1.Value = False
CheckBox1.Enabled = False
CheckBox2.Value = False
CheckBox2.Enabled = False
Else
CheckBox1.Value = False
CheckBox1.Enabled = True
CheckBox2.Value = False
CheckBox2.Enabled = True
End If
End Sub
You should probably just use Radios it would be a lot simpler.
If you are intent on doing this you will need to delete all your boxes and then put this code in. It will create and name your boxes and assign them code on click.
Alright, This needs to go in your Sheet module:
Sub Worksheet_Activate()
'Change Module2 to whatever the module name you are using is.
Module2.ActivateCheckBoxes ActiveSheet
End Sub
This next stuff will go into the module you're referencing from the Worksheet Module.
Sub ActivateCheckBoxes(sht As Worksheet)
If sht.CheckBoxes.Count = 0 Then
CreateCheckBoxes sht
End If
Dim cb As CheckBox
For Each cb In sht.CheckBoxes
'You may be able to pass sht as an object, It was giving me grief though
cb.OnAction = "'Module2.CheckBoxClick """ & cb.name & """, """ & sht.name & """'"
Next cb
End Sub
Sub CreateCheckBoxes(sht As Worksheet)
Dim cell As Range
Dim chkbox As CheckBox
With sht
Dim i As Long
Dim prevrow As Long
prevrow = 0
For Each cell In .Range("B2:D5") 'Change this to whatever range you want.
If prevrow < cell.row Then
prevrow = cell.row
i = 0
End If
Set chkbox = .CheckBoxes.Add(cell.Left, cell.Top, 30, 6)
With chkbox
.name = "CheckBox" & i & "_" & cell.row
.Caption = ""
End With
i = i + 1
Next cell
End With
End Sub
Sub CheckBoxClick(chkname As String, sht As String)
Dim cb As CheckBox
With Worksheets(sht)
For Each cb In .CheckBoxes
If Split(cb.name, "_")(1) Like Split(chkname, "_")(1) And Not cb.name Like chkname Then
cb.Value = -4146
End If
Next cb
End With
End Sub
You do not say anything about your sheet check boxes type... Please, test the next solution. It will be able to deal with both sheet check boxes type:
Copy this two Subs in a standard module:
Public Sub CheckUnCheckRow(Optional strName As String)
Dim sh As Worksheet, s As CheckBox, chK As OLEObject ' MSForms.CheckBox
Set sh = ActiveSheet
If strName <> "" Then
Set chK = sh.OLEObjects(strName) '.OLEFormat.Object
solveCheckRow chK.Object.Value, sh, Nothing, chK
Else
Set s = sh.CheckBoxes(Application.Caller)
solveCheckRow s.Value, sh, s
End If
End Sub
Sub solveCheckRow(boolVal As Long, sh As Worksheet, chF As CheckBox, Optional chK As OLEObject)
Dim s As CheckBox, oObj As OLEObject, iCount As Long
If Not chF Is Nothing Then
For Each s In sh.CheckBoxes
If chF.TopLeftCell.Address <> s.TopLeftCell.Address Then
If s.TopLeftCell.Row = chF.TopLeftCell.Row Then
s.Value = IIf(boolVal = -4146, 1, -4146): iCount = iCount + 1
If iCount = 2 Then Exit Sub
End If
End If
Next
ElseIf Not chK Is Nothing Then
For Each oObj In sh.OLEObjects
If oObj.TopLeftCell.Address <> chK.TopLeftCell.Address Then
If oObj.TopLeftCell.Row = chK.TopLeftCell.Row Then
boolStopEvents = True
oObj.Object.Value = IIf(boolVal = 0, True, False): iCount = iCount + 1
boolStopEvents = False
If iCount = 2 Then Exit Sub
End If
End If
Next
End If
End Sub
For case of Form check boxes type:
a). Manually assign the first sub to all your Form Type check boxes (right click - Assign Macro, choose CheckUnCheckRow and press OK).
b). Automatically assign the macro:
Dim sh As Worksheet, s As CheckBox
Set sh = ActiveSheet ' use here your sheet keeping the check boxes
For Each s In sh.CheckBoxes
s.OnAction = "'" & ThisWorkbook.Name & "'!CheckUnCheckRow"
Next
End Sub
If your check boxes have already assigned a macro, adapt CheckUnCheckRow, in Form check boxes section, to also call that macro...
For case of ActiveX check boxes:
a). Create a Public variable on top of a standard module (in the declarations area):
Public boolStopEvents
b). Manually adapt all your ActiveX check boxes Click or Change event, like in the next example:
Private Sub CheckBox1_Click()
If Not boolStopEvents Then CheckUnCheckRow "CheckBox1"
End Sub
Private Sub CheckBox2_Click()
If Not boolStopEvents Then CheckUnCheckRow "CheckBox2"
End Sub
Private Sub CheckBox3_Click()
If Not boolStopEvents Then CheckUnCheckRow "CheckBox3"
End Sub
and so on...
c). Or do all that with a click, using the next piece of code:
Sub createEventsAllActiveXCB()
Dim sh As Worksheet, oObj As OLEObject, strCode As String, ButName As String
Set sh = ActiveSheet 'use here your sheet keeping ActveX check boxes
For Each oObj In sh.OLEObjects
If TypeName(oObj.Object) = "CheckBox" Then
ButName = oObj.Name
strCode = "Private Sub " & ButName & "_Click()" & vbCrLf & _
" If Not boolStopEvents Then CheckUnCheckRow """ & ButName & """" & vbCrLf & _
"End Sub"
addClickEventsActiveXChkB sh, strCode
End If
Next
End Sub
Anyhow, the code cam be simplified in order to deal with only a type of such check boxes. If you intend to use it and looks too bushy, I can adapt it only for the type you like. Like it is, the code deals with both check box types, if both exist on the sheet...
Save the workbook and start playing with the check boxes. But, when you talk about check boxes on a row, all tree of them must have the same TopLeftCell.Row...
Tried looking this up but I'm still new to VBA and still pretty confused. I can't figure out how to get the variable from one sub and use it in another sub.
I want to get the variable ListBox1Items from GetListBox1Items and use it in cbSave_Click. I keep getting an error on Set oNewRow = Selection.ListObject.ListRows.Add(1). I tried Dim ListBox1Items As String and Public ListBox1Items As String but that doesn't help.
Does the module location of the sub matter? GetListBox1Items is in a Module. cbSave_Click is in a UserForm.
I looked up using Types but it got confusing.
Private Sub cbSave_Click()
Dim oNewRow As ListRow
Dim rng As Range
Set rng = ThisWorkbook.Worksheets("Creatures").Range("MonsterList")
Set oNewRow = Selection.ListObject.ListRows.Add(1)
With ws
Call GetListBox1
oNewRow.Range.Cells(1, 24).Value = Me.StatBox1.Value
oNewRow.Range.Cells(1, 35).Value = ListBox1Items
End With
End Sub
and GetListBox1 is
Sub GetListBox1()
Dim SelectedItems As String
Dim ListBox1Items As String
With MonsterMaker
For i = 0 To .ListBox1.ListCount - 1
If .ListBox1.Selected(i) = True Then
SelectedItems = SelectedItems & .ListBox1.List(i) & ", "
End If
Next i
ListBox1Items = Left(SelectedItems, Len(SelectedItems) - 2)
End With
End Sub
Take the follow abstract example:
Standard module code:
Option Explicit
Public ListBoxItems As String 'GLOBAL
Sub GetListBoxItems()
Dim selectedItems As String
Dim i as long
With ThisWorkBook.Worksheets("Sheet1").OLEObjects("ListBox1").Object 'amend as appropriate
For i = 0 to .ListCount-1
If .Selected(i) Then
selectedItems = selectedItems & .List(i) & ", "
End If
Next i
ListBoxItems = Left$(selectedItems,Len(selectedItems)-2)
End With
End Sub
In UserForm code:
Private Sub cbSave_Click()
Call GetListBoxItems
Debug.Print ListBoxItems
End Sub
Employee Login System using Excel with Macro.
I'm using a very simple technique of "if elseif then"
I want to display Employee Name when their ID is typed.
I used very simple code:
Dim CM As Boolean
Dim UserRange As Range
Dim x As Range
'EASY
Private Sub cmdClear_Click()
txtEmpID.Value = ""
txtName.Value = ""
txtEmpID.SetFocus
End Sub
Private Sub cmdLogin_Click()
End Sub
Private Sub txtEmpID_Change()
'If txtEmpID.Value = "111" Then
'txtName.Value = "Ryan"
'
'ElseIf txtEmpID.Value = "222" Then
'txtName.Value = "Tim"
'
'End If
End Sub
Private Sub UserForm_activate()
Do
If CM = True Then Exit Sub
TextBox1 = Format(Now, "hh:mm:ss")
DoEvents
Loop
Set UserRange = Sheets("Sheet1").Range("B:B")
For Each x In UserRange.Cells
If x.Value = txtEmpID.Text Then
x.Offset(1, 0) = txtName.Value
End If
Exit For
Next x
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
CM = True
End Sub
However I want to have a sheet that holds Employee Name (column A) and ID(column B) Sheet
Then from there, I can add more employee names and IDs. Also when I click on Login it will display the current time in Column C and then It will also display their time-out. Here's my main form Main Form
Thank you so much.
Not 100% sure I understand but here's my response:
Here's a way to update the field from the worksheet:
Private Sub txtEmpID_Change()
Dim mySheet As Worksheet
Dim myRange As Range
Set mySheet = Sheets("Emp_ID")
Set myRange = mySheet.Range("B:B").Find(txtEmpID.Value, , , xlWhole)
If Not myRange Is Nothing Then
txtName.Value = myRange.Offset(0, -1)
Else
txtName.Value = "Match not found"
End If
End Sub
Set that to occur whenever there's an update.
As for recording the login time: myRange.offset(0,1) = Format(Now,"hh:mm:ss")
How will you know / display the logout time when someone is logging in?