(VBA) Putting ComboBox + macroevent on cell change - vba

I'm trying to put a combobox inside active worksheet (but not activeX combobox), choose a list to fill and linked cell. It is an easy task, for example:
Sub make_combobox()
ActiveSheet.DropDowns.Add(69.75, 1.5, 79.5, 40.5).Select
Selection.Name = "combo"
ActiveSheet.Shapes("combo").Select
With Selection
.ListFillRange = "$A$1:$A$3"
.LinkedCell = "$D$1"
.DropDownLines = 8
.Display3DShading = False
End With
End Sub
I tried to put macro in worksheet containing this combobox, which will show msgbox whenever chosen linked cell is changed according to the chosen option in combobox. I wrote this in Worksheet section:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then
MsgBox "It works!"
End If
End Sub
Unfortunately, it doesn't work (Actually, it works when I change a value in D1 manually, but not work as a result of change in combobox).

Just assign a macro to the control using the OnAction property. It will run after every change made to the Combobox's value.

Related

How to add userform into this code instead of msgbox?

I currently have this code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
For Each myCell In Range("G4:G160")
If (Not IsEmpty(myCell)) And myCell.Value <> 17521 And myCell.Value <> "" Then
DisplayUserForm
Exit Sub
End If
Next myCell
End Sub
and have this for my userform
Sub DisplayUserForm()
Dim form As New WarningBox
form.LOL.Caption = "INCORRECT!"
form.Show
Set form = Nothing
End Sub
What else must I do in order for this to appear instead of msgbox to alert whoever is entering data will be showing "INCORRECT!" in bold and Surrounded by red.
Please see image below of what I am trying to show
Please follow these steps:
Insert a new Form by right-clicking on your VBA project and selecting UserForm under the Insert option.
Click once on the created form and then press the ``F4key to open theProperties``` window.
On the Properties window, the default name for your form is UserForm1. Change it to any new value as you want (e.g., WarningBox)
From the ToolBox window, drag and drop a Label on your form and adjust its size, font, font color, and all other properties that exist on the Properties window. Please rename the label to message. I will use this name later when calling the form to be shown.
If you want, like step 4, add a CommandButton to your form and change its name to for example okButton and adjust other properties as you want.
Double click on the button to write the code for this button. Write the code as follows:
Private Sub okButton_Click()
'Close the form
Unload Me
End Sub
Now, modify your DisplayUserForm() sub as follows:
Sub DisplayUserForm()
Dim form As New warningBox
form.message.Caption = "write your message here"
form.Show
Set form = Nothing
End Sub
All will be done as you want!
Marc: if your "Incorrect" message is the "LOL" object whose caption you modify with the code form.LOL.Caption = "INCORRECT!", it will be editable if it is a TextBox object. Saeed Sayyadipour's example shows using a Label object, instead, that will not be editable by the user (and I 'second' his advice about the "OK" button).
Also, though, since the event tells you which cells were changed by defining the "Target" range object, do you really need to loop through all of G4:G160, since only the cells within Target were changed by the user? Perhaps use For Each MyCell in Intersect(Target,Range("G4:G160")), or perhaps add these lines where appropriate:
Dim AffectedCells as Range
...
Set AffectedCells=Intersect(Target,Range("G4:G160"))
...
Set AffectedCells=Nothing
and change your loop to:
For Each myCell in AffectedCells
...
Next myCell
If there is no overlap between the changed range (Target) and your G4:G160, nothing happens and your code exits quickly.

Is there a way to have a scrollable list that is editable?

Following this video I have a spreadsheet that has a "Edit History" box on it that scrolls up and down. It uses a forms control scroll box and a list on a secondary sheet to create a scrollable list. The problem with this is that you cannot then edit the information in the scroll box (you must edit it on the secondary sheet).
I have VBA that automatically enters the person's name into the scrollbox when they edit any part of the sheet, and then enters "Note:" below that. I want the person to be able to edit the "Note:" box so that they can enter the reason they are editing the sheet:
John Smith and James Appleseed are previous users of this sheet. When Wayne Smith comes in to edit the sheet, as soon as he makes a change, it adds "Wayne Smith" and "Note:" to the sheet. (I already have this part working using VBA).
Because of the way that the scroll able list is implemented, it is actually all just formulas within this edit history box. If I double click "Note:" to try and edit it, this is what appears:
But what I want to happen is the ability to edit the "Note:" box (without having to switch to the secondary sheet where the list is actually stored). Essentially I want to make a scroll able text box that is also directly editable, and works with VBA.
Is there any way to do this?
I put together a working example of how to do this.
You can download the workbook here.
This method uses two sheets in a workbook... Sheet1 for the listbox and listboxdata for the data. Sheet1 can be called anything you like.
It would probably be wise to hide the listboxdata sheet.
On Sheet1 you need a Forms Control scrollbar. Use the Name Box to rename it: ScrollBar1. Assign to it the Scroll() procedure.
All of the code for this app should be placed in the Sheet1 code module:
Option Explicit
Private Const LISTBOX_SCROLLBAR = "scrollbar1"
Private Const LISTBOX_DATASHEET = "listboxdata"
Private Const LISTBOX_DATAHEADR = "a1"
Private Const LISTBOX_SCROLLMAX = 50
Private Const LISTBOX_SCROLLMIN = 1
Private Sub Scroll()
Dim ListBoxRows&, n&, ndx&, v
On Error Resume Next
With Shapes(LISTBOX_SCROLLBAR)
SetProps ndx
ListBoxRows = .BottomRightCell.Row - .TopLeftCell.Row
v = ThisWorkbook.Sheets(LISTBOX_DATASHEET).Range(LISTBOX_DATAHEADR).Resize(ListBoxRows).Offset(ndx)
Application.EnableEvents = False
.TopLeftCell(, 0).Resize(ListBoxRows) = v
End With
Application.EnableEvents = True
End Sub
Private Sub Update(Target As Range)
With Shapes(LISTBOX_SCROLLBAR)
If Target.Column = .TopLeftCell(, 0).Column Then
If Target.Row >= .TopLeftCell.Row And Target.Row <= .BottomRightCell.Row Then
If Target.Count = 1 Then
ThisWorkbook.Sheets(LISTBOX_DATASHEET).Range(LISTBOX_DATAHEADR).Offset(.ControlFormat.Value + Target.Row - .TopLeftCell.Row) = Target
Else
Scroll
End If
End If
End If
End With
End Sub
Private Sub SetProps(Optional ndx&)
With Shapes(LISTBOX_SCROLLBAR).ControlFormat
.Min = LISTBOX_SCROLLMIN
.Max = LISTBOX_SCROLLMAX
ndx = .Value
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Update Target
End Sub
Private Sub Worksheet_Activate()
SetProps
End Sub
That's it.
No formulas required in the listbox and any changes made to the cells in the listbox will be written to the source data and kept.

Using relative references to reuse a macro for a control

I'm trying to write an Excel 2007 macro for a coworker, but my VBA skills are pretty basic (pardon the pun). Essentially, what needs to happen is, when a checkbox is clicked, the neighboring cell to the right is filled with the username of the person logged in.
So far, here's the code I've come up with that allows me to do that:
Sub CheckBox1_Click()
Range("J4").Activate
If ActiveCell.Offset(0, 18).Value = True Then
ActiveCell.Offset(0, 1).Value = Environ("UserName")
Else
ActiveCell.Offset(0, 1).Clear
End If
End Sub
Just for the sake of reference, that "ActiveCell.Offset(0,18)" refers to a cell that is linked to the checkbox in question and contains its true/false value.
(EDIT: Also, the reason cell J4 is activated is because in this case, it's the cell containing the ActiveX checkbox)
That works perfectly, but that's not my problem. My problem is this: there are 49 more checkboxes in that row, and three more rows on this sheet, and 45 more sheets in this book. I do NOT want to have to copy paste the same code into a unique macro just to change the active cell. More importantly, as a good programmer, I shouldn't be repeating code like that. How should I write this so that I don't have to refer to a distinct cell every time?
EDIT 2: Holy smokes, Lance just helped me realize I was mistaken. The sheet uses form controls, not ActiveX controls. Greatly sorry, everyone.
While this is easy to do with a Sheet object, it's pretty hard to do with an ActiveX Control object. You can't self-reference the name of an ActiveX Control in its event, unless it's passed to it, and you also can't reference the name of the event subroutine to extract the name, and you can't reference the name of the routine that called a routine.
I also attempted to trigger off of the Worksheet Change and SelectionChange events, but those don't trigger off of a checkbox change, even if it has a LinkedCell that changes
What I finally came up with was the somewhat generic wrapper for the click event, that you'll have to modify the string to match the Checkbox name:
Private Sub CheckBox1_Click()
NameCopy Me, "CheckBox1"
End Sub
and then a Namecopy function that sets the cell -7 to the left of the LinkedCell to the name value.
Public Sub NameCopy(wsheet As Worksheet, cname As String)
If wsheet.OLEObjects(cname).Object.Value = True Then
Range(wsheet.OLEObjects(cname).LinkedCell).Offset(0, -7).Value = Environ("UserName")
End If
End Sub
It's easier with a Forms checkbox, you can use this Macro for all your checkboxes. Just remember to set the Macro to this:
Public Sub NameCopy()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
If shp.ControlFormat.Value = xlOn Then
ActiveSheet.Range(shp.ControlFormat.LinkedCell).Offset(0, -7).Value = Environ("UserName")
End If
End Sub
Since you are using form controls, this is really easy. You can use Application.Caller to have the code access the clicked checkbox, and then use it's TopLeftCell property to get where the checkbox is located, and then you can perform whatever operation you want. In your case, something like this I'm guessing:
Sub Checkbox_Click()
With ActiveSheet.CheckBoxes(Application.Caller)
If .Value = 1 Then 'Checkbox is checked
.TopLeftCell.Offset(, 1).Value = Environ("UserName")
Else
.TopLeftCell.Offset(, 1).ClearContents
End If
End With
End Sub

Change worksheet tab color if range of cells contains text

I have tried code that I've found here on stackoverflow, and elsewhere but they aren't working as I think they can. I'll list them below. I'm almost certain this is an easy question.
What I'm trying to do: If in any of the cells in the range A2:A100 there is any text or number whatsoever, then make the worksheet tab red. And I will need to do this on over 20 tabs. This must execute upon opening the workbook, and thus not require manually changing a cell or recalculating.
The problems I've had with other code: As far as I can tell they require editing a cell, and then quickly hitting enter again. I tried SHIFT + F9 to recalculate, but this had no effect, as I think this is only for formulas. Code 1 seems to work albeit with having to manually re-enter text, but no matter what color value, I always get a black tab color.
Code I've tried:
Code 1:
Private Sub Worksheet_Change(ByVal Target As Range)
MyVal = Range("A2:A27").Text
With ActiveSheet.Tab
Select Case MyVal
Case ""
.Color = xlColorIndexNone
Case Else
.ColorIndex = 6
End Select
End With
End Sub
Code 2: This is from a stackoverflow question, although I modified the code slightly to fit my needs. Specifically, if in the set range there are no values to leave the tab color alone, and otherwise to change it to color value 6. But I'm sure I've done something wrong, I'm unfamiliar with VBA coding.
Private Sub Worksheet_Calculate()
If Range("A2:A100").Text = "" Then
ActiveWorkbook.ActiveSheet.Tab.Color = xlColorIndexNone
Else
ActiveWorkbook.ActiveSheet.Tab.Color = 6
End If
End Sub
Thanks for your help!
I posted this on superuser first, but perhaps stackoverflow is more appropriate since it is explicitly programming-related.
Only two things will be able to switch the condition in this statement:
If Range("A2:A100").Text = "" Then
You've already identified both of them, changing the contents of the one of the cells in that range on a worksheet, or a formula in one of those cells recalculating to or from a value of "". As far as event triggers go, if the formula result changes, both the WorkSheet_Calculate and Worksheet_Change events will fire. Of the two, Worksheet_Change is the one to respond to, because WorkSheet_Calculate will only fire if any of the cells in A2:A100 contain a formula. Not if they only contain values - your "Code 2" isn't wrong, the event was just never firing.
The simple solution is to set your tab colors when you open the workbook. That way it doesn't matter if you have to activate a cell in that range and change it - that's only way the value you're testing against is going to change.
I'd do something like this (code in ThisWorkbook):
Option Explicit
Private Sub Workbook_Open()
Dim sheet As Worksheet
For Each sheet In Me.Worksheets
SetTabColor sheet
Next sheet
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Sh.Range("A2:A100")) Is Nothing Then
SetTabColor Sh
End If
End Sub
Private Sub SetTabColor(sheet As Worksheet)
If sheet.Range("A2:A100").Text = vbNullString Then
sheet.Tab.Color = xlColorIndexNone
Else
sheet.Tab.Color = 6
End If
End Sub
EDIT: To test for the presence of specific text, you can do the same thing but need to have the test check every cell in the range you're monitoring.
Private Sub SetTabColor(sheet As Worksheet)
Dim test As Range
For Each test In sheet.Range("A2:A100")
sheet.Tab.Color = xlColorIndexNone
If test.Text = "whatever" Then
sheet.Tab.Color = vbRed
Exit For
End If
Next test
End Sub
Maybe test the len of the trimmed joined string of cells:
Private Sub Worksheet_Calculate()
If Len(Trim(Join(Application.Transpose(Range("A2:A100"))))) = 0 Then
ActiveWorkbook.ActiveSheet.Tab.Color = xlColorIndexNone
Else
ActiveWorkbook.ActiveSheet.Tab.Color = 6
End If
End Sub
This code will fire off every time the sheet calculates though as it is event code, I am not sure if that is what you want? If not then post back and we can drop it into a normal sub for you and make it poll all the sheets to test.
Worksheet_Change function will get called everytime there's change in the target range. You just need to place the code under Worksheet. If you have placed the code in the module or Thisworkbook then it wont work.
Paste the below in Sheet1 of your workbook and check if it works. Of Course you will need to do modification to the below code as I have not written complete code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
Set WatchRange = Range("A1:A20")
Set IntersectRange = Intersect(Target, WatchRange)
If IntersectRange Is Nothing Then
''Here undo tab color
Else
ActiveSheet.Tab.ColorIndex = 6
End If
End Sub

Excel VBA - Capitalizing all selected cells in column on double click

I have a very simple VBA script, that capitalizes the selected cell:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveCell.Value = UCase(ActiveCell.Value)
End Sub
It works as expected, but sometimes I would like to capitalize all cells in a selected column, but only if I double click on the column itself. It seems that I cannot receive events with Worksheet_BeforeDoubleClick when clicking the column fields..
Is there some workaround for this?
Like I mentioned, Why not a shortcut key?. You can assign a shortcut key for your macro as shown below
Now all you have to do is select the column and press the shortcut key.
Also, instead of looping through every cell in a column, here is a code which is based on a ONE LINER HACK by Peter Albert.
Put this in a module.
Sub ChangeToUpper()
Dim rng As Range
'~~> Check if what the user selected is a valid range
If TypeName(Selection) <> "Range" Then
MsgBox "Select a range first."
Exit Sub
End If
Set rng = Selection
rng = WorksheetFunction.Transpose(Split(UCase(Join( _
WorksheetFunction.Transpose(rng), vbBack)), vbBack))
End Sub
Screenshot:
If DoubleClick is not mandatory, you could use BeforeRightClick. If you want to keep original right click context menu, you could import the module and check for Ctrl/Alt/Shift
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim condition As Boolean
condition = True ' check Ctrl/Alt/Shift using http://www.cpearson.com/excel/KeyTest.aspx
If condition Then
MsgBox "Right Click at " & Target.Address
Cancel = True
End If
End Sub
Another option is to assign a Ctrl+[] in Macro options to a macro instead of an event handling and call the macro to process the Selection object.