Expand and collapse rows using Excel VBA - vba

I'm building a form with different sections. I do not want to use either a Command button or a Toggle button (their look is ugly) and since this is for clients I want it to be user friendly. Anyway so basically I want to build a macro that when they click on the shape it will collapse the unnecessary rows and expand the right rows.
So far this is what I was able to find... but it only applies to a command button.
Private Sub CommandButton1_Click()
With Me.CommandButton1
If .Caption = "Initial Request" Then
.Caption = "Hide Rows"
Rows("12:20").Hidden = False
Else
.Caption = "Initial Request"
Rows("12:200").Hidden = True
End If
End With
End Sub
This works perfectly... but, is there a way to transform this so that it can be added to a Module and therefore assigned to a shape?
Thank you very much for your help

You can add a shape, say a Rectangle and assign it a macro with this equivalent code to yours:
Sub Rectangle2_Click()
With Sheet3.Shapes("rectangle 2").TextFrame2.TextRange
If .Text = "Initial Request" Then
.Text = "Hide Rows"
sheet3.Rows("12:20").Hidden = False
Else
.Text = "Initial Request"
sheet3.Rows("12:20").Hidden = True
End If
End With
End Sub
Obviously in this example I added a rectangle shape to Sheet3 and it got the name "rectangle 2". You should adjust these names to your case.

Give this code a try:
Option Explicit
Sub Cloud_Click()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet2")
If ws.Shapes("Cloud 2").TextFrame2.TextRange.Text = "Initial Request" Then
ws.Shapes("Cloud 2").TextFrame2.TextRange.Text = "Hide rows"
ws.Rows("12:20").Hidden = False
Else
ws.Shapes("Cloud 2").TextFrame2.TextRange.Text = "Initial Request"
ws.Rows("12:20").Hidden = True
End If
End Sub
I sure hope that the following screen-cast will explain the rest.

Related

Repeating legacy option buttons within a repeating section

I am currently attempting to turn a form I am working on into a more dynamic one using vba in word, but I am facing two issues with the option buttons within a repeating section:
The code is not dynamic; when I run the code it does what I need it to but doesn't dynamically recalculate as I change my choice.
The option buttons do not repeat when I add a new section, and the only way for me to include them is by readding them and creating a new module specific for the new option button group.
Below is a picture of the section I am repeating and the code I am using.
enter image description here
Private Sub Yes_Click()
Dim k(0 To 3) As String
k(0) = "Select one"
k(1) = "Pass"
k(2) = "Fail"
k(3) = "N/A"
Dim i As Long
If Yes = True Then
Me.Controls.Clear
Me.Controls1.Clear
For i = 0 To 3
Me.Controls.AddItem k(i)
Me.Controls1.AddItem k(i)
Next i
End If
On Error Resume Next
Me.Controls = "Select one"
Me.Controls1 = "Select one"
If Yes = False Then
Me.Controls = "N/A"
Me.Controls1 = "N/A"
End If
On Error Resume Next
End Sub
Is there a way to approach either issues?
Thanks in advance.

Excel vba-- macro to add a new comment and set focus to that comment

I'd like to imitate the behavior of the default insert comment button with a macro. I want to store all of my macros in the Personal workbook, not the active workbook.
I'd like it to simply create a comment and then set the focus to that empty comment.
Below is what I have so far, using Terry's suggestion to make the comment .Visible and then .Shape.Select it:
Sub addNewComment()
Dim authorName As String
Dim authorNameLength As Integer
authorName = Application.UserName
authorNameLength = Len(authorName)
ActiveCell.AddComment _
authorName & ":" _
& Chr(10)
With ActiveCell.Comment
With .Shape
.AutoShapeType = msoShapeFoldedCorner
.Fill.ForeColor.RGB = RGB(215, 224, 239)
With .TextFrame
.AutoSize = True
.Characters.Font.Size = 11
.Characters.Font.Name = "Calibri"
.Characters(1, (authorNameLength + 1)).Font.Bold = True
.Characters((authorNameLength + 2), 1).Font.Bold = False
End With
End With
.Visible = True
.Shape.Select True
End With
End Sub
I'm not sure how to get the comment to go back to not being visible. Do I store the reference to the cell I just added the comment to, and then refer to that cell with the Worksheet_SelectionChange event? Or do I make that event just hide all comments on the sheet? Is it possible to use Worksheet_SelectionChange at all with the Personal workbook?
Also, my comment box does not resize as I type and add line breaks. It does resize after I exit, but actually too large by about four lines. Not sure why that is happening.
I'm sure there is a cleaner way to organize my With blocks as well.
I tried using the following to hide the comment again after selecting another cell:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Comment.Visible = False
End Sub
I received the following error:
error 91: Object variable or With block variable not set
You can select the comment once you make it visible using the following:
With range("a1")
.Comment.Visible = True
.Comment.Shape.Select True
End With
But I think you'll need to have another macro to hide the comment again once you deselect, as otherwise it will stay visible. You could try doing this on the SelectionChange event of the worksheet:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Comment.Visible = False
End Sub

Excel VBA combobox doesn't allow to select specific items from list

I have a combobox in my worksheet with a dynamic search, the dynamic search is done by searching the typed letters in a list that is on another worksheet. The search is done by excel formulas. The list is a defined range and then the combobox listfillrange is set to the named range.
When I type the dropdown list opens, for certain items the combobox allows me to select from the list and for others the selection disappear as I select. I tried figure why do these items disappear. The list is long (10,000 items) so it kind of works slow, but I am not sure if this is the problem.
How can I fix such a problem? Is there a way to define a variable for the mouseclick selection from dropdown list?
Thanks in advance,
Tali
This is my code:
Private Sub ComboBox1_Change()
Sheets("PS").EnableCalculation = True
ComboBox1.ListFillRange = "DropDownList"
ComboBox1.DropDown
End Sub
Private Sub CommandButton21_Click()
Dim PS As Worksheet
Application.ScreenUpdating = False
Application.ErrorCheckingOptions.BackgroundChecking = False
Sheets("PharmaSoft").Select
Set PS = Sheets("PS")
SelectionA = PS.Range("J2").Value
If ComboBox1.Value = SelectionA Then
Range("J19") = "Pharmacy purchase price"
Range("N19") = PS.Range("K2")
Range("O19") = "ILS"
Range("J21") = "Pharmacy selling price Incl.VAT"
Range("N21") = PS.Range("L2")
Range("O21") = "ILS"
Range("J23") = "Package size"
Range("N23") = PS.Range("M2")
Range("J19:O23").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
Application.ScreenUpdating = True
Range("N19").Errors.Item(1).Ignore = True
Range("N21").Errors.Item(1).Ignore = True
Range("N23").Errors.Item(1).Ignore = True
Else
MsgBox "Please select a product", vbCritical, "Error"
End If
Sheets("PS").EnableCalculation = False
End Sub
Private Sub CommandButton22_Click()
Application.ScreenUpdating = False
Sheets("PharmaSoft").Select
ComboBox1.Value = Null
Range("J19:O23").Value = Null
Application.ScreenUpdating = True
End Sub
Also the code for the workbook:
Private Sub Workbook_Open()
Sheets("PharmaSoft").Select
Application.ScreenUpdating = False
Sheets("PharmaSoft").ComboBox1.Value = Null
Range("J19:O23").Value = Null
Application.ScreenUpdating = True
End Sub
Although I can't comment on what you're doing given that your search is done as you mention with excel formulas. I do know that using data validation via a combo box can be pretty quick. The method I use is as per this page and is extremely fast. It's pretty much instantaneous on a validation range that is about 15k rows long. The best part about it is that it provides auto completion. So when you type in the combo box and that value isn't in the list, the entry that matched one character ago disappears. It's a good visual cue whether you're selection is valid or not. And of course, you can still use the drop down box in the usual way. The only down side is that, as coded at the link provided, you have to double-click to enter the auto-completion mode.

Mandatory fields red. Now how to save?

What it does: Requires fields from users. Blocks user from saving if specific fields are missing. Turns those fields red until saved correctly.
What I need: Well, how the hell am I supposed to save this...
What I would like: Since the worksheet is blank. I cannot save. and required fields are red. EVEN if I could save I would LIKE the cells to be on no fill until I roll it out.
View Original Post Here
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim xlSht As Worksheet
Dim cellsNotPopulated As Boolean
cellsNotPopulated = False
Set xlSht = ThisWorkbook.Worksheets("1st Call")
With xlSht
If .Range("F7") = "" Then
.Range("F7").Interior.Color = RGB(255, 0, 0)
cellsNotPopulated = True
Else
.Range("F7").Interior.ColorIndex = xlNone
End If
End With
If cellsNotPopulated = True Then
MsgBox "Please review the highlighted cells and ensure the fields are populated."
Cancel = True
End If
End Sub
If you are in the middle of development and want to "break the rules" and save your current efforts, then in a standard module:
Sub MyPrivateSave()
Application.EnableEvents = False
ThisWorkbook.Save
Application.EnableEvents = True
End Sub
Of course, when you finish development, you would remove this little "save tool" before you send the workbook out to the users.
or add as the first line if environ("Username")=your username then exit sub

VBA Grey Checkboxes

I would like to grey out my checkboxes in Excel VBA. When using Checkbox.Enabled = False, the checkbox is not editable, but it is also not grey. How do I get the greyed out effect?
Using form controls with Excel 2010. Inserted via developer tab directly into excel worksheet. Not used in a VBA userform.
Thanks!
Whenever anyone says "it is impossible", it hits my stubborn streak. So may I present to you: "The Impossible".
"Visible" and enabled checkbox:
"Disabled" checkbox (you can tweak the degree of visibility by changing values in the code for both color and transparency of the cover shape):
Basic idea: you place a semi transparent shape over the checkbox, and assign a dummy macro to it. Now you can't change the value of the checkbox. The "toggle" button is there to change the state - either place the shapes, or remove them. It uses a global variable to track the current state.
Finally - note that you can't use For Each when you delete (or add) shapes as you should not modify the collection you are iterating over. I circumvented that with a simple "count shapes, then iterate backwards by numerical index".
Is it a hack? You bet! Does it do what you asked? Yes!
Dim checkBoxesVisible As Boolean
Option Explicit
Sub toggleIt()
' macro assigned to "Toggle visibility" button
checkBoxesVisible = Not checkBoxesVisible
toggleCheckboxes checkBoxesVisible
End Sub
Sub grayOut(cb)
' put a "cover" shape over a checkbox
' change the color and transparency to adjust the appearance
Dim cover As Shape
Set cover = ActiveSheet.Shapes.AddShape(msoShapeRectangle, cb.Left, cb.Top, cb.Width, cb.Height)
With cover
.Line.Visible = msoFalse
With .Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0.4
.Solid
End With
End With
cover.Name = "cover"
cover.OnAction = "doNothing"
End Sub
Sub doNothing()
' dummy macro to assign to cover shapes
End Sub
Sub unGray(cb)
' find the cover shape for the checkbox passed as the argument
' and delete it
' "correct shape" has the name "cover" and is properly aligned with top left
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.Name = "cover" And sh.Left = cb.Left And sh.Top = cb.Top Then
sh.Delete
Exit For
End If
Next sh
End Sub
Sub toggleCheckboxes(onOff)
Dim s As Shape
Dim n As Integer, ii As Integer
n = ActiveSheet.Shapes.Count
' loop backwards over shapes: if you do a "For Each" you get in trouble
' when you delete things!
For ii = n To 1 Step -1
Set s = ActiveSheet.Shapes(ii)
If s.Type = msoFormControl Then
If s.FormControlType = xlCheckBox Then
If onOff Then
unGray s
Else
grayOut s
End If
End If
End If
Next ii
End Sub
A slight hack - but the following does work. I created a simple userform with two controls - a regular checkbox (CheckBox1), and a button I called "DisableButton" with the following code:
Private Sub DisableButton_Click()
CheckBox1.Enabled = Not (CheckBox1.Enabled)
If CheckBox1.Enabled Then
CheckBox1.ForeColor = RGB(0, 0, 0)
Else
CheckBox1.ForeColor = RGB(128, 128, 128)
End If
End Sub
When I clicked the button, the checkbox was grayed out and unavailable. Clicking it again "brought it back to life". I think this is the effect you were looking for. If it's not - that's what comments are for.
Here is what it looks like:
I am afraid it is impossible what you are trying to do within a worksheet. You can refer to the Floris' answer if you are using an UserForm.
For more details on the properties of (Form/worksheet) check boxes see MSDN
Maybe this is what you want.
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
CheckBox2.Value = False
CheckBox2.Enabled = False
CheckBox2.ForeColor = rgbBlue
Else
CheckBox2.Visible = True
CheckBox2.ForeColor = rgbAntiqueWhite
CheckBox2.Enabled = True
End If
Code tels that when checkbox1 is checked, checkbox2 is disabled; unchecked and the forecollor changes. the colors can be what you want.
Did this with the checkboxes directly in the excel worksheet.
Based on Floris' idea.
The code assumes all the controls are on ActiveSheet and they are called CheckBox1 and CheckBox2, if not, change it accordingly.
You can call this when you click on CheckBox1 or you can call it from another sub, with an optional ticked status (True/False) to check or uncheck CheckBox1.
Draw an object on top of CheckBox2 and name it "mask" (you can name it anything else but then you have to change the code accordingly)
Give mask the same fill color as your background color and opacity of around 50%.
Public Sub CheckBox1_Click(Optional ticked As Variant)
Application.ScreenUpdating = False
ActiveSheet.Unprotect
If Not IsMissing(ticked) Then
If ticked = True Then ActiveSheet.Shapes("CheckBox1").OLEFormat.Object.Value = 1 Else ActiveSheet.Shapes("CheckBox1").OLEFormat.Object.Value = -4146
End If
If ActiveSheet.Shapes("CheckBox1").OLEFormat.Object.Value > 0 Then
ActiveSheet.Shapes("mask").OLEFormat.Object.ShapeRange.ZOrder msoSendToBack
Else
ActiveSheet.Shapes("mask").OLEFormat.Object.ShapeRange.ZOrder msoBringToFront
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub
Now each time you tick CheckBox1, mask comes to front to hide CheckBox2 and when you untick it, mask goes to back to unhide it. Since it is opaque, it gives you the greyed out effect and you don't even have to worry about enable/disable either.
Worksheet should be protected so that user can't accidentally move or edit mask, but should be unprotected for SendToBack/BringToFront to work, so the code does that. Please check the protection settings at the Application.Protect part.