I use the following code to automatically generate a new checkbox and link a cell to it:
ActiveSheet.CheckBoxes.Add().LinkedCell = Selection.Address
I want to create another sub which should change the background color of the .LinkedCell cell of the checkbox when the checkbox is checked (blue) or unchecked (red). I will have about 200 checkboxes in the worksheet.
Is there a way to get/return the .LinkedCell address of the currently checked/unchecked checkbox so that the sub can change the background color of that cell?
For example let's presume that the .LinkedCell is the cell in which the checkbox was initially placed. This would be the initial status of each checkbox:
and this would be the result after the user checks/unchecks the checboxes:
until now I used this code to change the background color of the checkbox itself. But I don't want that, I want to change the color of the .LinkedCell.
Sub SetMacro()
Dim cb
For Each cb In ActiveSheet.CheckBoxes
If cb.OnAction = "" Then cb.OnAction = "CheckedUnchecked"
Next cb
End Sub
and
Sub CheckedUnchecked()
With ActiveSheet.Shapes(Application.Caller).DrawingObject
If .Value = 1 Then
.Interior.ColorIndex = 5
Else
.Interior.ColorIndex = 3
End If
End With
End Sub
You could replace your CheckedUnchecked code with the following:
Sub CheckedUnchecked()
With ActiveSheet.Range(ActiveSheet.CheckBoxes(Application.Caller).LinkedCell)
If .Value Then
.Interior.ColorIndex = 5
Else
.Interior.ColorIndex = 3
End If
End With
End Sub
Related
I have an Initialization for a userform. It works fine when I initialize using the commented out part of the code, but when I use the code as shown below, I get a runtime error 91.
I need a way to loop through or select all textboxes to give them default value, color and etc...
Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As Control
For i = 1 To 4
ctl = "TextBox" & i
ctl.Value = ""
Next i
'TextBox1.Value = ""
'TextBox2.Value = ""
'TextBox3.Value = ""
'TextBox4.Value = ""
End Sub
In general, to refer to a TextBox of the form, you need Controls("TextboxN). If you want to loop, it is like this - Me.Controls("Textbox" & i), in case that you have not deleted any textboxes and they are following the default order
Thus, this is a possibility:
Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As Control
For i = 1 To 4
Me.Controls("Textbox" & i) = i
Me.Controls("Textbox" & i).BackColor = vbGreen
Next i
Debug.Print Me.TextBox3.Value
End Sub
With this screenshot, showing each TextBox getting a value of 1,2,3 or 4 and a green color:
Or even this, if you want to make the outlook of the controls a bit different:
Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As Control
For i = 1 To 4
With Me.Controls("Textbox" & i)
.Value = i
If i Mod 2 = 0 Then
.BackColor = vbBlue
.ForeColor = vbWhite
Else
.BackColor = vbGreen
.BackColor = vbRed
End If
End With
Next i
End Sub
If you are naming the textboxes, following your own programming logic, then looping through the collection of controls and checking the TypeName of the control is a better solution.
make a procedure in normal module:
Sub LoopTxBox()
Dim tb As MSForms.Control
For Each tb In UserForm1.Controls
If TypeName(tb) = "TextBox" Then 'capitalisation matters
'...
End If
Next tb
End Sub
and call it in UserForm_Initialize().
The code below shows three check boxes in vba, each of them (if checked) highlight a specific cell background in my workbook yellow. Is it possible so If one checkbox is checked the background will be yellow, if two are selected it will be orange and if three are selected it will be red. Also if none are selected there will be no fill for the background. I have the no fill and yellow part so far but I cant figure out how to add the other two colors. Anything helps, thanks.
Sub CheckBox25_Click()
With ActiveSheet.CheckBoxes("Check Box 25")
If .Value = xlOn Then
Worksheets("Sheet1").Range("C18").Interior.ColorIndex = 27
Else: Worksheets("Sheet1").Range("C18").Interior.ColorIndex = 0
End If
End With
End Sub
Sub CheckBox26_Click()
With ActiveSheet.CheckBoxes("Check Box 26")
If .Value = xlOn Then
Worksheets("Sheet1").Range("C18").Interior.ColorIndex = 27
Else: Worksheets("Sheet1").Range("C18").Interior.ColorIndex = 0
End If
End With
End Sub
Sub CheckBox27_Click()
With ActiveSheet.CheckBoxes("Check Box 27")
If .Value = xlOn Then
Worksheets("Sheet1").Range("C18").Interior.ColorIndex = 27
Else: Worksheets("Sheet1").Range("C18").Interior.ColorIndex = 0
End If
End With
End Sub
Put this in the same module as the above code:
Sub colorCell()
Dim CB25 As Long
Dim CB26 As Long
Dim CB27 As Long
CB25 = (ActiveSheet.CheckBoxes("Check Box 25").Value = xlOn) * -1
CB26 = (ActiveSheet.CheckBoxes("Check Box 26").Value = xlOn) * -1
CB27 = (ActiveSheet.CheckBoxes("Check Box 27").Value = xlOn) * -1
With Worksheets("Sheet1").Range("C18").Interior
Select Case CB25 + CB26 + CB27
Case 1
.ColorIndex = 27
Case 2
.ColorIndex = 27 'Change to your color
Case 3
.ColorIndex = 27 'Change to your color
Case Else
.ColorIndex = 0
End Select
End With
End Sub
Then in each event change to be like this one:
Sub CheckBox25_Click()
colorCell
End Sub
Now, every time one changes it will do the count and change the color accordingly.
I have an Excel sheet which contains some values in the cells A1 to A9. I have a text box and command button 1 (renamed to "previous") and command button 2 (renamed to "Next").
When I click the Next button the values in the cells from A1 to A9 should be displayed in the text box which I have in an order from A1 to A9 and when the Previous button is clicked it should behave in the reverse.
edited: added Solution "B" for Form controls
Solution A for ActiveX controls
1) double click "Previous" button and VBA gets you in the sheet code pane with
Private Sub CommandButton1_Click()'<~~ maybe your "Previous" button was not the 1st ActiveX button you inserted in the sheet so the sub title has a different number in it: don't bother and just keep it as you find it
End Sub
that you fill like follows:
Private Sub CommandButton1_Click() '<~~ remember: keep the number you already have there in the sub name
UpdateTextBox 1
End Sub
2) double click "Next" button and and VBA gets you in the sheet code pane with
Private Sub CommandButton2_Click() '<~~ maybe your "Next" button was not the 2d ActiveX button you inserted in the sheet so the sub title has a different number in it: don't bother and just keep it as you find it
End Sub
that you fill like follows:
Private Sub CommandButton2_Click()'<~~ remember: keep the number you already have there in the sub name
UpdateTextBox -1
End Sub
3) place this code in any module code pane
Option Explicit
Sub UpdateTextBox(shift As Long)
Dim found As Range, myRange As Range
Dim s As OLEObject
Dim index As Long
With ActiveSheet
Set s = .OLEObjects("TextBox1") '<~~ set the name of the ActiveX TextBox control
Set myRange = .Range("A1:A9") '<~~ set the range you want to scroll up and down
End With
index = 1 '<~~ default index position should textbox be empty or filled with non valid value
With myRange
If s.Object.Value <> "" Then '<~~ get current textbox value index in range
Set found = .Find(what:=s.Object.Value, LookIn:=xlValues, lookat:=xlWhole) '<~~ search for the current text current textbox value index in range
If Not found Is Nothing Then index = found.Row - .Rows(1).Row + 1
End If
index = index + shift '<~~ make the shift
Select Case index
Case Is > .Rows.Count
index = .Rows.Count '<~~ limit max index to range last row
Case Is < 1
index = 1 '<~~ limt min index to range first row
End Select
s.Object.Value = .Rows(index) '<~~ update textbox value
End With
End Sub
Solution B for Form controls
1) add this in any module code pane
Option Explicit
Sub SkipToNext()
UpdateTextBox2 1
End Sub
Sub SkipToPrevious()
UpdateTextBox2 -1
End Sub
Sub UpdateTextBox2(shift As Long)
Dim s As Shape
Dim found As Range, myRange As Range
Dim index As Long
With ActiveSheet
Set s = .Shapes("TextBox 1") '<~~ set the name of the Form TextBox control
Set myRange = .Range("A1:A9") '<~~ set the range you want to scroll up and down
End With
index = 1 '<~~ default index position should textbox be empty or filled with non valid value
With myRange
If s.TextFrame.Characters.Text <> "" Then '<~~ get current textbox value index in range
Set found = .Find(what:=s.TextFrame.Characters.Text, LookIn:=xlValues, lookat:=xlWhole) '<~~ search for the current text current textbox value index in range
If Not found Is Nothing Then index = found.Row - .Rows(1).Row + 1
End If
index = index + shift '<~~ make the shift
Select Case index
Case Is > .Rows.Count
index = .Rows.Count '<~~ limit max index to range last row
Case Is < 1
index = 1 '<~~ limt min index to range first row
End Select
s.TextFrame.Characters.Text = .Rows(index) '<~~ update textbox value
End With
End Sub
2) assign SkipToNext() to the "Next" button and SkipToPrevious() to the "Previous" button
Starting with a TextBox and two buttons from AutoShapes. Enter the following in a standard module:
Public WhereAmI As Long
Sub Nextt()
Dim s As Shape
Set s = ActiveSheet.Shapes("TextBox 1")
If CStr(WhereAmI) = "" Then
WhereAmI = 1
s.TextFrame.Characters.Text = Range("A1").Text
Else
If WhereAmI = 9 Then Exit Sub
WhereAmI = WhereAmI + 1
s.TextFrame.Characters.Text = Cells(WhereAmI, 1).Text
End If
End Sub
Sub Prevv()
Dim s As Shape
Set s = ActiveSheet.Shapes("TextBox 1")
If CStr(WhereAmI) = "" Then
WhereAmI = 2
s.TextFrame.Characters.Text = Range("A2").Text
Else
If WhereAmI = 1 Then Exit Sub
WhereAmI = WhereAmI - 1
s.TextFrame.Characters.Text = Cells(WhereAmI, 1).Text
End If
End Sub
Then assign Nextt() to the "Next" button and assign Prevv() to the "Previous" button:
From the above, if you click Next, gamma will be in the box. If you click Previous, alpha will be in the box.
EDIT#1:
I use the Public variable to keep track of which of the items is currently in the TextBox............that way the subs can get to the next or previous value.
All three Shapes (textbox and two buttons) are easily available from AutoShapes:
In my version of Excel, that menu is in the Insert tab. When you first start out, there will be nothing in the TextBox, that is the reason for the CStr() test.
EDIT#2:
To handle the case of having the initial value of WhereAmI being 0, use this version of Prevv():
Sub Prevv()
Dim s As Shape
Set s = ActiveSheet.Shapes("TextBox 1")
If CStr(WhereAmI) = "" Then
WhereAmI = 2
s.TextFrame.Characters.Text = Range("A2").Text
Else
If WhereAmI = 1 Then Exit Sub
If WhereAmI = 0 Then WhereAmI = 2
WhereAmI = WhereAmI - 1
s.TextFrame.Characters.Text = Cells(WhereAmI, 1).Text
End If
End Sub
I am trying to create a spreadsheet in which I need a button in each row to stamp the time in the cell next to it and then sort the rows in order of time. My problem is that the buttons do not move. E.g. Button in cell B1 changes time in cell A1 and button in cell B2 changes time in cell A2 and for this example lets say A2 has a lower time than A1 so when sorted A1 and A2 effectively swap data. Now the button in B2 changes the time in cell A1.
Been trying to figure this out for hours, any help would be greatly appreciated.
Based on David's comment, you can try this set up.
Dim r As Range
Private Sub CommandButton21_Click()
r.Offset(0, -1).Value = Time
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo halt
Application.EnableEvents = False
If Target.CountLarge > 1 Then GoTo moveon
Dim btn As OLEObject: Set btn = Me.OLEObjects("CommandButton21")
If Not Intersect(Target, Me.Range("B:B")) Is Nothing Then
Set r = Target
With btn
.Visible = True
.Left = r.Left
.Top = r.Top
.Width = r.Width
.Height = r.Height
End With
Else
btn.Visible = False
End If
moveon:
Application.EnableEvents = True
Exit Sub
halt:
MsgBox Err.Description
Resume moveon
End Sub
You need to create an ActiveX Control with CommandButton21 as its name.
This buttons move and appear when something is selected in Column B.
You can add your sort routine on the CommandButton21_Click event.
I need code that colors text that is only automatic. Specifically, I have text that is clean and then text that is blue and bolded. I want the clean text to become red, bolded, and with a strikethrough. This is the code I am working with and the entire cell both clean and blue bolded text become red, bolded, and strikedthrough.
Sub KeepBlueBold()
'keeps bluebold cell
Dim Cell As Range
For Each Cell In Selection
KeepBlueAddRed Cell
Next Cell
End Sub
Sub KeepBlueAddRed(Cell As Range)
Dim iCh As Integer
For iCh = 1 To Len(Cell)
With Cell.Characters(iCh, 1)
If .FOnt.ColorIndex <> 1 Then
Text = Text & .Text
End If
End With
Next iCh
Cell.Value = Text
Cell.Characters.FOnt.Strikethrough = True
Cell.Characters.FOnt.Bold = True
Cell.Characters.FOnt.ColorIndex = 3
End Sub
The code below should work, given you have a range already selected.
Sub KeepBlueBold()
Dim c As Range
For Each c In Selection.Cells
If c.Font.ColorIndex = 1 Then
c.Font.ColorIndex = 3
c.Font.Bold = True
c.Font.Strikethrough = True
End If
Next
End Sub