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.
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().
I have this code but it's not working as I want it.
This is what I want:
-if I write something in cell A1,A2 or A3 (in worksheet1) a textbox is created in worksheet(2). This works but now I want the place of the textbox to change when I right in cell B1,B2,B3.
I tried to do that with the code below, but I think there might be a problem with the way I defined the Range("B" & CStr(i)) because when I use just B1 it works.
I need to change the code two do two things differently:
1- If I write in B1 "cliente" I want the texbox with the text from A1 to be created in toppos=150 and if I change it to "financeiro" I want the texbox to be created in toppos=20.
2- If B1 and B2 have "fianceiro" written I want the textboxes related to A1 and A2 to be next to each other.
Can someone help me?
Thank you
So this is what I want:
-Textboxes created with the content of cells A1 to A3 on worksheet 2;
-If I change the content the content of the textbox should be updated, if I erase the value then the textbox should be deleted;
-the position of the textboxes should change with the options I choose in column B. I want the worksheet(2) to have 4 "slices", the first is for the option "financeiro", so all the textboxes related to that slice of page should be in a specific place in the worksheet, for example, in position 20, if on the other hand that textbox is from the option "cliente", the textbox should be in the slice related to "cliente", position 150.
-also each option in column B might have more then one textbox so I want the textboxes from the same option to appear side by side.
Sub removercaixas(strName As String)
Dim shp As Shape
For Each shp In Worksheets(2).Shapes
If shp.Type = msoTextBox And shp.Name = strName Then shp.Delete
Next shp
End Sub
Sub criarcaixastexto(strName As String)
Dim wsActive As Worksheet
Dim box As Shape
Set wsActive = Worksheets(2)
Dim leftpos As Long
Dim toppos As Long
Dim i As Long
For i = 1 To 3
If Worksheets(1).Range("B" & CStr(i)).Value = "financeiro" Then
toppos = 20
ElseIf Worksheets(1).Range("B" & CStr(i)).Value = "cliente" Then
toppos = 150
ElseIf Worksheets(1).Range("B" & CStr(i)).Value = "processos internos" Then
toppos = 250
Else:
toppos = 350
End If
Next i
Select Case strName
Case Is = "$A$1"
leftpos = 50
Case Is = "$A$2"
leftpos = 200
Case Is = "$A$3"
leftpos = 350
End Select
Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, leftpos, toppos, 100, 50)
box.TextFrame.Characters.Text = Worksheets(1).Range(strName).Value
box.Name = strName
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Select Case Target.Address
Case "$A$1", "$A$2", "$A$3"
removercaixas (Target.Address)
If Len(Target) > 0 Then criarcaixastexto (Target.Address)
Case Else
Exit Sub
End Select
End Sub
I'm not sure of some of the OP's logic or exactly what he wants to accomplish. Instead of adding and removing textboxes, I would create a Function that would create the textbox, if needed, and return a reference to it.
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Or Not Sh.Index = 1 Or Len(Target) = 0 Then Exit Sub
Dim box As Shape
If Not Intersect(Target, Range("B1:B3")) Is Nothing Then
Set box = getCaixas(Worksheets(2), Target.Offset(0, -1).Address)
Select Case Target.Value
Case Is = "financeiro"
box.Top = 20
Case Is = "cliente"
box.Top = 150
Case Is = "processos internos"
box.Top = 250
End Select
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim box As Shape
If Target.Count > 1 Or Not Sh.Index = 1 Or Len(Target) = 0 Then Exit Sub
If Not Intersect(Target, Range("A1:A3")) Is Nothing Then
Set box = getCaixas(Worksheets(2), Target.Address)
Select Case Target.Address
Case Is = "$A$1"
box.Left = 50
Case Is = "$A$2"
box.Left = 200
Case Is = "$A$3"
box.Left = 350
End Select
box.TextFrame.Characters.Text = Target.Value
End If
End Sub
Function getCaixas(ws As Worksheet, CaixasName As String) As Shape
Dim box As Shape
On Error Resume Next
Set box = ws.Shapes(CaixasName)
If Err.Number <> 0 Then
Set box = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 100, 50)
box.Name = CaixasName
End If
On Error GoTo 0
Set getCaixas = box
End Function
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
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
I have a form in Excel macro. This form will capture the values inserted in textboxes, listbox and store in Sheet2.
There are 2 buttons in the form applet named "Next" and "Previous". These button will be used for navigating between the saved records. I am able to navigate between records and the values display fine in textboxes. However, I am not sure how can I display the Values from listboxes. My list box is a multiselect list box.
I have provided snippet of my code on how the records are saved in sheet2 and how the navigation happens when clicked on Next button.
Private Sub Save_Click()
Dim ctl As Control
Dim S As String
Dim i As Integer
RowCount = Worksheets("Sheet2").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Sheet2").Range("A1")
.Offset(RowCount, 0).Value = Me.Name1.Value ' capture value from list box
'below code is for capturing value from multiselect listbox
With AOI
For i = 0 To .ListCount - 1
If .Selected(i) = True Then S = S & ", " & .List(i)
Next i
Range("A1").Offset(RowCount, 10).Value = S
End With
End Sub
Below code is for navigating between saved records..
Private Sub Next1_Click()
strCurrentSetofRows = Worksheets("Sheet2").Range("A1").CurrentRegion.Rows.Count
i = i + 1: j = 0
If i > (strCurrentSetofRows - 1) Then
MsgBox "No More Records"
Exit Sub
End If
Set sRange = Worksheets("Sheet2").Range("A1")
Name1.Text = sRange.Offset(i, j).Value: j = j + 1
End Sub
Any thoughts on how can I display saved values of AOI (my field).
Since you are storing the values using , as a separator, you can use the same to split the values and upload it to the ListBox. BTW, I hope you are generating the ListBox with the complete list in the UserForm's Initialize event?
Here is a very basic example. Please amend it to suit your needs.
Let's say Cell A1 has Blah1,Blah2,Blah6. Then try this code
Option Explicit
Dim i As Long, j As Long
Private Sub UserForm_Initialize()
ListBox1.MultiSelect = fmMultiSelectMulti
For i = 1 To 10
ListBox1.AddItem "Blah" & i
Next
End Sub
Private Sub CommandButton1_Click()
Dim ArValues As Variant
Dim sValue As String
Dim multivalues As Boolean
If InStr(1, Range("A1").Value, ",") Then
ArValues = Split(Range("A1").Value, ",")
multivalues = True
Else
sValue = Range("A1").Value
multivalues = False
End If
If multivalues = True Then
For i = 0 To UBound(ArValues)
For j = 0 To ListBox1.ListCount - 1
If ListBox1.List(j) = ArValues(i) Then
ListBox1.Selected(j) = True
Exit For
End If
Next j
Next i
Else
For j = 0 To ListBox1.ListCount - 1
If ListBox1.List(j) = sValue Then
ListBox1.Selected(j) = True
Exit For
End If
Next j
End If
End Sub
Screenshot