basically I have a userform which I would like to use to enter 2 data into another macro which I already have. The userform is as below:
Basically, I would like the OK button to be clicked and the data in the two boxes will be entered into another macro that I have. It would also be great if the OK button can help in a sense that it will prompt a warning if one of the boxes is not filled up.
So far, I do not have much of a code for this..
Private Sub UserForm_Click()
TextBox1.SetFocus
Sub Enterval()
End Sub
Private Sub TextBox1_Change()
Dim ID As String
ID = UserForm3.TextBox1.Value
End Sub
Private Sub TextBox2_Change()
Dim ID2 As String
ID2 = UserForm3.TextBox2.Value
End Sub
Private Sub OKay_Click()
Enterval
End Sub
Would appreciate any tips and help. Thanks!
My other macro
Private Sub CommandButton1_Click()
Dim Name As String
Dim Problem As Integer
Dim Source As Worksheet, Target As Worksheet
Dim ItsAMatch As Boolean
Dim i As Integer
Set Source = ThisWorkbook.Worksheets("Sheet1")
Set Target = ThisWorkbook.Worksheets("Sheet2")
Name = Source.Range("A3")
Problem = Source.Range("I13")
Do Until IsEmpty(Target.Cells(4 + i, 6)) ' This will loop down through non empty cells from row 5 of column 2
If Target.Cells(4 + i, 6) = Name Then
ItsAMatch = True
Target.Cells(4 + i, 7) = Problem ' This will overwrite your "Problem" value if the name was already in the column
Exit Do
End If
i = i + 1
Loop
' This will write new records if the name hasn't been already found
If ItsAMatch = False Then
Target.Cells(3, 6).End(xlDown).Offset(1, 0) = Name
Target.Cells(4, 6).End(xlDown).Offset(0, 1) = Problem
End If
Set Source = Nothing
Set Target = Nothing
End Sub
Thats the macro i have. As u said, i change the
othermacro
to CommandButton1_Click()
but it doesn't work
Quoting geoB except for one thing: when you .Show your UserForm from a main Sub, you can also .Hide it at the end and the macro that called it will continue its procedures.
Sub Okay_Click()
Dim sID1 As String, sID2 As String
' A little variation
If Me.TextBox1 = "" Or Me.TextBox2 = "" Then
MsgBox "Please fill all the input fields"
Exit Sub
End If
Me.Hide
End Sub
To address your TextBox, you can write in your main Sub UserForm3.TextBox1 for example
There is no need for an Enterval function. Instead, assume the user can read and follow instructions, then test whether that indeed is the case. Note that in your code ID and ID2 will never be used because they exist only within the scope of the subroutines in which they are declared and receive values.
To get started:
Sub Okay_Click()
Dim sID1 As String, sID2 As String
sID1 = UserForm3.TextBox1.Value
sID2 = UserForm3.TextBox2.Value
If Len(sID1 & vbNullString) = 0 Then
MsgBox "Box A is empty"
Exit Sub
End If
If Len(sID2 & vbNullString) = 0 Then
MsgBox "Box B is empty"
Exit Sub
End If
'Now do something with sID1, sID2
otherMacro(sID1, sID2)
End Sub
For your other macro, declare it like this:
Sub otherMacro(ID1, ID2)
...
End Sub
Also, the SetFocus method should occur in the form open event.
Related
I load a userform via a double-click event executed on a range of cells. Once any of the cells in the range gets double clicked, my userform is loaded.
I would like the input boxes of the userform populated with data that is based on an offset of the triggering cell.
I am struggling with capturing the address of the cell that triggered the event, and consequently would need to figure out how to offset from that cell's column and obtain the relevant value for population in the userform.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Sheets("Daily Summary").Range("D27:D93")) Is Nothing Then
Cancel = True
CommentDetails.Show
End If
End Sub
a) How do I capture the dynamic cell address that triggered the userform load?
b) How do I offset three columns to the right, capture that cell's value and load it into the userform's input field named first_name?
Thanks to #Zwenn in the comments for pointing me in the right direction with Application.Caller. Updated code below, it executes but shows a Object Required error.
The name of the form is CommentDetails, the name of the input field is TextBoxArrival, both of which matches the code.
Private Sub Userform_initialize()
Me.TextBoxArrival.Value = Cells(Application.Caller.Row, Application.Caller.Column + 1)
'TextBoxArrival.Value = Cells(Application.Caller.Row, Application.Caller.Column + 1)
'MsgBox Cells(Application.Caller.Row, Application.Caller.Column + 1).Value, vbOKOnly
End Sub
I understand I have to declare application.caller along with the calling method, which in my case is Sub Worksheet_BeforeDoubleClick. Still getting the same error. I tried circumventing this by calling another separate sub before loading the userform.
Where do I define application.caller?
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim callingCellRow As Integer
If Not Application.Intersect(Target, Sheets("Daily Summary").Range("D27:D29")) Is Nothing Then
Select Case TypeName(Application.Caller)
Case "Range"
callingCellRow = Application.Caller.Row
callingCellColumn = Application.Caller.Column
Case "String"
callingCellRow = Application.Caller.Row
callingCellColumn = Application.Caller.Column
callingCellSheet = Application.Caller
Case "Error"
MySheet = "Error"
Case Else
MySheet = "unknown"
End Select
With CommentDetails
.Tag = callingCellRow '<~~ tell the UserForm there's something to bring in so that it'll fill controls from the sheet instead of initializing them
.Show
.Tag = ""
End With
Unload CommentDetails
End If
End Sub
There's 3 ways to do this explained on Daily Dose of Excel by Dick Kusleika (18 years ago!). I prefer the 3rd option as it handles the form instance with a variable.
In Worksheet_BeforeDoubleClick you can have this:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim objForm As UserForm1
If Not Application.Intersect(Target, Me.Range("B2:D2")) Is Nothing Then
Cancel = True
Set objForm = New UserForm1 ' <-- use a variable for the form instance
Set objForm.rngDoubleClicked = Target ' <-- set property of the form here with Target
objForm.Show
End If
End Sub
And then in the form code:
Option Explicit
Private m_rngDoubleClicked As Range
' set only
Public Property Set rngDoubleClicked(rng As Range)
Set m_rngDoubleClicked = rng
End Property
' use the property
Private Sub UserForm_Activate()
Dim strAddress As String
Dim rngOffset As Range
' m_rngDoubleClicked is now the range that was double clicked
strAddress = m_rngDoubleClicked.Parent.Name & "!" & m_rngDoubleClicked.Address
Set rngOffset = m_rngDoubleClicked.Offset(3, 0)
Me.TextBox1.Text = "The address of the double clicked cell is " & strAddress
Me.TextBox2.Text = "The value 3 rows down from double clicked cell is " & rngOffset.Text
End Sub
Private Sub UserForm_Initialize()
' no args for initialization unfortunately :(
End Sub
Example:
I have a data in column B which is dynamic ( cities can be in any order) , what I am looking is for a VBA code to fill color in the rectangle shape ( I have renamed rectangle shapes to corresponding city names). based on the color of corresponding city.
This is sample list, and actual data can be long, Hence was looking for an automated script to do this task.
Please, try the next approach. It will use a class, able to trigger the interior color change:
Insert a class module, name it "clsCelColorCh", copy and place the next code:
Option Explicit
Private WithEvents cmBar As Office.CommandBars
Private cellsCountOK As Boolean, arrCurColor(), arrPrevColor(), sCellAddrss() As String
Private sVisbRngAddr As String, i As Long, objSh As Worksheet, cel As Range, rngBB As Range
Public Sub ToSheet(sh As Worksheet)
Set objSh = sh
End Sub
Public Sub StartWatching()
Set cmBar = Application.CommandBars
End Sub
Private Sub Class_Initialize()
cellsCountOK = False
End Sub
Private Sub cmBar_OnUpdate()
If Not ActiveSheet Is objSh Then Exit Sub
Set rngBB = Intersect(ActiveWindow.VisibleRange, objSh.Range("B:B"))
If rngBB Is Nothing Then Exit Sub
If sVisbRngAddr <> rngBB.Address And sVisbRngAddr <> "" Then
Erase sCellAddrss: Erase arrCurColor: Erase arrPrevColor
sVisbRngAddr = "": cellsCountOK = False
End If
i = -1
On Error Resume Next
For Each cel In rngBB.cells
ReDim Preserve sCellAddrss(i + 1)
ReDim Preserve arrCurColor(i + 1)
sCellAddrss(i + 1) = cel.Address
arrCurColor(i + 1) = cel.Interior.Color
If arrPrevColor(i + 1) <> arrCurColor(i + 1) Then
If cellsCountOK = True Then 'call the pseudo event Sub
CallByName objSh, "Cell_ColorChange", VbMethod, cel
arrPrevColor(i + 1) = arrCurColor(i + 1)
End If
End If
i = i + 1
If i + 1 >= rngBB.cells.count Then
cellsCountOK = True
ReDim Preserve arrPrevColor(UBound(arrCurColor))
arrPrevColor = arrCurColor
End If
arrPrevColor(i + 1) = arrCurColor(i + 1)
Next
On Error GoTo 0
sVisbRngAddr = rngBB.Address
End Sub
Copy the next code in the sheet to monitor color changes code module (right click on the sheet name and choose View Code):
Option Explicit
Private ColorChEventMonitor As clsCelColorCh
Public Sub Cell_ColorChange(Target As Range)
Dim sh As Shape
On Error Resume Next
Set sh = Me.Shapes(Target.Value)
On Error GoTo 0
If Not sh Is Nothing Then
sh.Fill.ForeColor.RGB = Target.Interior.Color
Else
MsgBox "No shape named as """ & Target.Value & """ in this sheet..."
End If
End Sub
Private Sub Worksheet_Activate()
StartEventWatching
End Sub
Private Sub Worksheet_Deactivate()
StopEventWatching
End Sub
Private Sub StartEventWatching()
Set ColorChEventMonitor = New clsCelColorCh
ColorChEventMonitor.ToSheet Me
ColorChEventMonitor.StartWatching
End Sub
Private Sub StopEventWatching()
Set ColorChEventMonitor = Nothing
End Sub
Deactivate the sheet in discussion (go on a different sheet) and go back. I this way, the sheet Activate event starts the color change monitoring.
It does it for color changes in column "B:B".
In order to see it working, of course, there must be so many shapes as records in column "B:B", named exactly like the cells value. Anyhow, if a cell value does not match any shape, no error will be raised, a message mentioning that a correspondent shape does not exist will appear.
The pseudo event is triggered when you select another cell. Sometimes, it is triggered only by simple changing the color, but not always...
Please, test it and send some feedback.
I'm trying to do something (I think) easy, but I can't find it.
At the start of my Excel file I add the string values from the array (which is created meanwhile because you can't define a const string array):
Private Sub Workbook_Open()
CompleteAddList
End Sub
/
Public Function CompleteAddList(
For Each a In ArrAddList
With ActiveWorkbook.Sheets("Sheet 1").Shapes("AddList1").ControlFormat
.List = a
End With
MsgBox (a)
Next a
End Function
/
Public Function ArrAddList()
ArrAddList = Array("Text1", "Text2")
End Function
I see the message boxes, but the data is not stored in the combobox (it's still empty).
Is this because it's in a public function ? Or is it just not correct the way I wrote it?
Please, test the next code. It assumes that the combo in discussion is a Form type:
Sub testDropDownFill()
Dim sh As Worksheet, cb As DropDown, ArrAddList
Set sh = Sheets("Sheet 1") 'take care of the space between Sheet and 1
Set cb = sh.DropDowns("AddList1")
ArrAddList = Array("Text1", "Text2")
cb.list = ""
cb.list = ArrAddList
End Sub
If the combo in discussion is an ActiveX type, plese use the next code:
Sub testComboActXFill()
Dim sh As Worksheet, cb As MSForms.ComboBox, ArrAddList
Set sh = Sheets("Sheet 1") 'take care of the space between Sheet and 1
Set cb = sh.OLEObjects("ComboBox1").Object
ArrAddList = Array("Text1", "Text2")
cb.Clear
cb.list = ArrAddList
End Sub
I am experimenting with the capabilities of a User Form to assist in Data entry. I would like to know if there is a specific code that can transfer the Value of a Checkbox to a Text box that is on the same User Form when the box is checked. Basically, instead of having to type all of the words out, it would be easier to simply check a series of boxes to create the sentence. I know how to input the Checkbox value into the Excel worksheet but I have yet to figure out how to have that same value entered into a Text Box that would provide a "Preview" of the sentence for editing purposes and then the data can be transferred to the Excel Worksheet once it has been approved in the User Form. In my attached example that I had created and I have a before and the desired after result of what I am looking to do.
Thank you
JLY Test form:
EDIT:
Though really, you'd be best off using a listbox, much easier and shorter code. Put your list of items in a worksheet and set that to a dynamic named range so you can edit it and the userform will pick it up on the fly. Make sure the listbox has a MultiSelect property set to fmMultiSelectExtended and the ListStyle property is set to fmListStyleOption. Then you can select multiple entries in the listbox by holding the Ctrl key.
In this example if have put it in Sheet1 (though can be any sheet, and the sheet can even be hidden), and then set a dynamic named range named listProperties to this formula: =Sheet1!$A$2:INDEX(Sheet1!$A:$A,MAX(2,ROWS(Sheet1!$A:$A)-COUNTBLANK(Sheet1!$A:$A)))
Then the userform has this code:
Private Sub listJewelryProperties_Change()
Dim sTemp As String
Dim i As Long
For i = 0 To Me.listJewelryProperties.ListCount - 1
If Me.listJewelryProperties.Selected(i) = True Then sTemp = sTemp & " " & Me.listJewelryProperties.List(i)
Next i
Me.txtPreview.Text = WorksheetFunction.Trim(sTemp)
End Sub
Private Sub UserForm_Initialize()
Me.listJewelryProperties.Clear
Me.listJewelryProperties.List = ActiveWorkbook.Sheets("Sheet1").Range("listProperties").Value
End Sub
And this is what the results look like:
Original Answer Here for Posterity:
Alternate solution, set all your checkboxes to call a function and pass an argument of their value and caption, then the function will update the textbox. The reason for using the .Tag property is to avoid removing too much due to duplicates in partial matches for the checkboxes (such as Ring and Ring Band where just plain Ring can be found within Ring Band, this way it will only remove the Ring entry, and not incorrectly remove both Ring entries)
Private Sub chk14ktWhiteGold_Click()
UpdatePreview Me.chk14ktWhiteGold.Value, Me.chk14ktWhiteGold.Caption
End Sub
Private Sub chkAntique_Click()
UpdatePreview Me.chkAntique.Value, Me.chkAntique.Caption
End Sub
Private Sub chkArtisinal_Click()
UpdatePreview Me.chkArtisinal.Value, Me.chkArtisinal.Caption
End Sub
Private Sub chkBand_Click()
UpdatePreview Me.chkBand.Value, Me.chkBand.Caption
End Sub
Private Sub chkHandCarved_Click()
UpdatePreview Me.chkHandCarved.Value, Me.chkHandCarved.Caption
End Sub
Private Sub chkHandEtched_Click()
UpdatePreview Me.chkHandEtched.Value, Me.chkHandEtched.Caption
End Sub
Private Sub chkHandmade_Click()
UpdatePreview Me.chkHandmade.Value, Me.chkHandmade.Caption
End Sub
Private Sub chkRing_Click()
UpdatePreview Me.chkRing.Value, Me.chkRing.Caption
End Sub
Private Sub chkRingBand_Click()
UpdatePreview Me.chkRingBand.Value, Me.chkRingBand.Caption
End Sub
Private Sub chkSterlingSilver_Click()
UpdatePreview Me.chkSterlingSilver.Value, Me.chkSterlingSilver.Caption
End Sub
Private Sub chkVintage_Click()
UpdatePreview Me.chkVintage.Value, Me.chkVintage.Caption
End Sub
Private Sub UpdatePreview(ByVal bChkState As Boolean, ByVal arg_sText As String)
If bChkState = True Then
Me.txtPreview.Text = WorksheetFunction.Trim(Me.txtPreview.Text & " " & arg_sText)
If Len(Me.txtPreview.Tag) = 0 Then
Me.txtPreview.Tag = arg_sText
Else
Me.txtPreview.Tag = Me.txtPreview.Tag & "|" & arg_sText
End If
Else
Me.txtPreview.Tag = Replace("|" & Me.txtPreview.Tag & "|", "|" & arg_sText & "|", "|")
Me.txtPreview.Text = WorksheetFunction.Trim(Replace(Me.txtPreview.Tag, "|", " "))
End If
End Sub
Something like below will do that for you, as I don't know the names of your UserForm or your Checkboxes, you will have to amend as required, also you will have to add the following code to each of the CheckBoxes Click Event:
Private Sub CheckBox1_Click()
UserForm1.TextBox1.Text = UserForm1.TextBox1.Text & " " & CheckBox1.Caption
End Sub
UPDATE:
To also remove when checkbox is unchecked, the following code will do that:
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
UserForm1.TextBox1.Text = UserForm1.TextBox1.Text & " " & CheckBox1.Caption
Else
pos = InStr(UserForm1.TextBox1.Text, CheckBox1.Caption)
If pos > 0 Then UserForm1.TextBox1.Text = Replace(UserForm1.TextBox1.Text, " " & CheckBox1.Caption, "")
End If
End Sub
I have a to do list in excel. When a check box is checked a macro is ran that selects a specific cell and adds values to offsets of that cell. The problem is I have 600 check boxes and they all need their own code to reference the correct cells.
private sub checkbox1_click ()
Range ("I2").offset(0,3).value= "hello world"
Sub end
I want something like this:
Range ("location of checkbox I just checked").offset(0,3).value= "hello world"
This would be easier if you are using ActiveX control checkboxes instead of Form control.
With ActiveX control checkboxes, you can refer to the object as a part of Me, which points to the worksheet itself and use something like this:
Private Sub CheckBox1_Click()
If Me.CheckBox1.Value = True Then
Me.CheckBox1.TopLeftCell.Offset(0, 3).Value = "hello world"
End If
End Sub
If you can't use ActiveX controls, please let me know and I can adjust my answer. Note that you could also look at more information on how to make a checkbox refer to itself by looking at the answer to this question.
In the answer from PeterT, you can also see how to use a Class Module to avoid the problem of having one macro per checkbox. Here, I'm copying the relevant part of the answer:
[...] Create a class module that you can instantiate for any number of
CheckBoxes.
Code for Class module MyCheckBoxClass
Dim WithEvents cbControl As MSForms.CheckBox
Private controlName As String
Public Sub cbControl_Click()
Debug.Print controlName & " is now " & cbControl.Value
If cbControl.Value = True Then
Range("CheckBoxCount") = Range("CheckBoxCount") + 1 'choose to store on the sheet
groupCheckBoxCount = groupCheckBoxCount + 1 'or in a variable
Else
Range("CheckBoxCount") = Range("CheckBoxCount") - 1
groupCheckBoxCount = groupCheckBoxCount - 1
End If
End Sub
Public Sub Attach(newCB As MSForms.CheckBox, newName As String)
Set cbControl = newCB
controlName = newName
End Sub
Private Sub Class_Initialize()
controlName = ""
End Sub
Code in a regular code module:
Public groupClickCount As Integer
Private cbCollection As Collection
Public Sub SetUpControlsOnce()
Dim thisCB As MyCheckBoxClass
Dim ctl As OLEObject
Dim cbControl As MSForms.CheckBox
If cbCollection Is Nothing Then
Set cbCollection = New Collection
End If
For Each ctl In ThisWorkbook.Sheets("Sheet1").OLEObjects
If TypeName(ctl.Object) = "CheckBox" Then
'--- this is an ActiveX CheckBox
Set thisCB = New MyCheckBoxClass
thisCB.Attach ctl.Object, ctl.name
cbCollection.Add thisCB
End If
Next ctl
End Sub
Of course, you would have to replace "Sheet1" with the appropriate name for your sheet and
If cbControl.Value = True Then
Range("CheckBoxCount") = Range("CheckBoxCount") + 1 'choose to store on the sheet
groupCheckBoxCount = groupCheckBoxCount + 1 'or in a variable
Else
Range("CheckBoxCount") = Range("CheckBoxCount") - 1
groupCheckBoxCount = groupCheckBoxCount - 1
End If
With
If cbControl.Value = True Then
cbControl.TopLeftCell.Offset(0, 3).Value = "hello world"
End If
And finally, I would suggest to run the SetUpControlsOnce macro when you open the workbook by including it in the Open Event of the Workbook Object (Thisworkbook). ie.:
Private Sub Workbook_Open()
Call SetUpControlsOnce
End Sub