looping through worksheet command buttons and change visibility - vba

I'm trying to write a code to make a number of buttons visible depending on a cell value
I have 10 command buttons all are invisible and I want to show only the first x
x is the value of cell "A1" in "Sheet1" (will be from 1 to 10)
Command buttons names are default names (CommandButton4, CommandButton5, ... , CommandButton13)
Note: I'm working with a worksheet not a userform
This is my code but i need something shorter and more pro and efficient
Private Sub CommandButton15_Click()
Dim i As Long
Dim CommandButton() As Variant
Application.ScreenUpdating = False
CommandButton = Array("CommandButton4", "CommandButton5", "CommandButton6", "CommandButton7", "CommandButton8", "CommandButton9", "CommandButton10", "CommandButton11", "CommandButton12", "CommandButton13")
For i = LBound(CommandButton) To LBound(CommandButton) + Sheet1.Range("A1").Value - 1
Sheet1.Shapes(CommandButton(i)).Visible = True
Next i
Application.ScreenUpdating = True
End Sub
Need ur help plz

As said in the comment you should rename your buttons. That just makes things easier.
You could for example name them "btn1", "btn2", "btn3" ....
Your code is ok and i can't see major errors. I don't know if you want to add new buttons later.
If so i would recommend something more generic. If you rename the buttons to "btn1"... then you could use something like this:
Private Sub CommandButton15_Click()
Dim btn As OLEObject, name As String, i As Long
i = Sheets(1).Range("A1").Value + 1
For Each btn In ActiveSheet.OLEObjects
name = btn.name
If btn.OLEType = xlButtonOnly And InStr(name, "btn") = 1 Then
If Int(Right(name, Len(name) - 3)) < i Then
btn.Visible = True
Else
btn.Visible = False
End If
End If
Next
End Sub
So you can add new buttons name them with the "btn.." pattern and you don't have to change your Code.

Related

Looping through Control Names and hiding all controls that contain the right number within a frame

What I am trying to do is on a Word Userform, if I select a number in a combo box (cb_CountCohorts) (options are 1-10) then any control (option button or textbox that contains that number +1 (so if I select 5, those controls that have 6-10) will not be visible.
With that being said, I did get it to work but I know that it is not efficient.
Below is the beginning but I realize for each case, there would have to be 10 more sets of what you see below times 10 different If statements. Is there a way to say something like if cb_Countcohrts ="1" find all controls in this frame that does not contain Cohort 1 and hide it...if cb_countcohorts ="5" then hide everything that contains cohort 6, 7, 8, 9, 10? Thanks in advance for all and any help
Private Sub cb_CountCohorts_Change()
If cb_CountCohorts = "1" Then
txt_cohort1.Visible = True
txt_cohort2.Visible = False
txt_cohort3.Visible = False
txt_cohort4.Visible = False
txt_cohort5.Visible = False
txt_cohort6.Visible = False
txt_cohort7.Visible = False
txt_cohort8.Visible = False
txt_cohort9.Visible = False
txt_cohort10.Visible = False
I tried this too but it doesnt seem to work like I want either
Private Sub cb_CountCohorts_Change()
For i = 2 To 10
Set VarText = frm_master.Controls("txt_cohort" & i)
If cb_CountCohorts.Value > VarText.Value Then
VarText.Visible = False
End If
Next i
End Sub
Something like this:
Private Sub cb_CountCohorts_Change()
Dim v As Long, i As Long
v = CLng(cb_CountCohorts.Value)
For i = 2 To 10
Me.Controls("txt_cohort" & i).Visible = (i <= v)
'any other controls here....
Next i
End Sub
If you want something generic for all controls (assuming a consistent naming convention) -
Private Sub cb_CountCohorts_Change()
Dim v As Long, c, i As Long, arr
v = CLng(cb_CountCohorts.Value)
For Each c In Me.Controls
If c.Name Like "txt_cohort#*" Then
arr = Split(c.Name, "_")
i = CLng(Replace(arr(1), "txt_cohort", ""))
c.Visible = (i <= v)
End If
Next c
End Sub
...basically expanded from Robert's suggestion
Untested, but this should work:
Dim c As Control
For Each c In Me.Controls
If InStr(TypeName(c),"cohort") Then
c.Visible = False
End If
Next

Setting a VBA form object using a string

Hello,
I am trying to set up a form which is a calendar from which the user can select a date (by default the current month appears). The form consists of 42 command buttons (I have left the default name ie. CommandButton1) which I am setting the day number.
At the moment I have a long-winded section of code for each button (I used Excel to generate this rather than type it all out) which locks and hides the button if it is outside of the month in question which looks like this:
NewDate.CommandButton1.Caption = Format(DATlngFirstMonth - DATintDayNumFirst + DATintX, "dd")
If DATintX < DATintDayNumFirst Then
With NewDate.CommandButton1
.Locked = True
.Visible = DATbooShowExtraDays
.ForeColor = RGB(150, 150, 150)
End With
Else
With NewDate.CommandButton1
.Locked = False
.Visible = True
.ForeColor = RGB(0, 0, 0)
End With
End If
I know that I can refer to a command button by:
Dim objCommandButton As Object
Set objCommandButton = NewDate.CommandButton1
..which neatens the code up somewhat. But what I would like to do is refer to the command button as a string so I can loop through all 42, ie.
Dim n as integer
n = 1
Do Until n > 42
Set objCommandButton = NewDate.CommandButton & n
'Some operations
n = n + 1
Loop
Many thanks in advance for assistance.
You can loop through all controls of the form. Try
Sub LoopButtons()
Dim it As Object
For Each it In NewDate.Controls
Debug.Print it.Name
Next it
End Sub
Then you can put conditional expression (if ... then) in place of Debug.Print or whatever. For example
If Instr(it.Name, "CommandButton") Then
'do your code
end if
Here's code which iterates over ActiveX controls on active sheet:
Sub IterateOverActiveXControlsByName()
Dim x As Integer
Dim oleObjs As OLEObjects
Dim ctrl As MSForms.CommandButton
Set oleObjs = ActiveSheet.OLEObjects
For x = 1 To 10
Set ctrl = oleObjs("CommandButton" & x).Object
Next
End Sub

drop down list combo box excel

I have a searchable combo box with suggestions to select from as I type letters in it (vba below). However i want to be able to click the arrow of the combo box (if i don't type anything else in it of course) and see the entire drop down list. For some reason the code below does not show me the entire list if I click the arrow.
Any suggestions much appreciated.
Dim ws As Worksheet
Dim x, dict
Dim i As Long
Dim str As String
Set ws = Sheets("Lists")
x = ws.Range("Listing").value
Set dict = CreateObject("Scripting.Dictionary")
str = Me.cbo1.value
If str <> "" Then
For i = 1 To UBound(x, 1)
If InStr(LCase(x(i, 1)), LCase(str)) > 0 Then
dict.Item(x(i, 1)) = ""
End If
Next i
Me.cbo1.List = dict.keys
Else
Me.cbo1.List = x
End If
Me.cbo1.DropDown
What you want is that if the arrow is clicked when nothing is yet selected or written in the combo by the user, to show all the items of the list, which you load from the named range "Listing" without any filtering.
To do so, add this event handler to your userform's code:
Private Sub Cbo1_DropButtonClick()
'If Len(Trim(cbo1.text)) = 0 Then
If Trim(cbo1.text) = "type here" Then
cbo1.List = Sheets("Lists").Range("Listing").Value
Exit Sub
End If
' Your code to add only items that match the characters typed by the user
' ...
End Sub

Excel: How to retrieve the frozen range of the Worksheet programmatically?

I'm using VSTO to build an Excel add-in.
I want to build two functions. The first one, stores the frozen range at my Excel.Range variable called RNG and then unfreeze panes, using the following command.
Globals.ThisAddIn.Application.ActiveWindow.FreezePanes = False
The second function selects the range and freezes it again. With the following
RNG.Select()
Globals.ThisAddIn.Application.ActiveWindow.FreezePanes = True
What i don't know is how to store the frozen range before unfreeze the window.
Does someone can help me with doing this, or knows some other workaround?
Thanks.
With #Byron 's help, I solved my problem. Here is my code!
'Flag that indicates if there is a "frozen" scenario stored in the other variables
Private frozen_scenario As Boolean
'Range that marks the first cell of the frozen header
Private range_freeze_begin As Excel.Range
'Range that marks the the first cell not contained by the frozen header
Private range_freeze_end As Excel.Range
'Range that marks the the first visible cell (in the not fixed pane)
Private first_visible_cell_not_fixed As Excel.Range
'Unfreezes the panes, saving the current scenario
Private Sub unfreezeLines()
With Globals.ThisAddIn.Application.ActiveWindow
If .FreezePanes Then
Dim frozen_pane_limit_line As Integer
Dim frozen_pane_limit_column As Integer
frozen_pane_limit_line = .Panes(1).VisibleRange.Rows.Count + 1
frozen_pane_limit_column = .Panes(1).VisibleRange.Columns.Count + 1
If .Panes.Count = 2 Then
If .Panes(1).VisibleRange(1, 1).Row = .Panes(2).VisibleRange(1, 1).Row Then
frozen_pane_limit_line = 1
Else
frozen_pane_limit_column = 1
End If
Me.first_visible_cell_not_fixed = .Panes(2).VisibleRange(1, 1)
Else '4 panes
Me.first_visible_cell_not_fixed = .Panes(4).VisibleRange(1, 1)
End If
Me.range_freeze_begin = .Panes(1).VisibleRange(1, 1)
Me.range_freeze_end = Me.sheet.Cells(frozen_pane_limit_line, frozen_pane_limit_column)
Me.frozen_scenario = True
.FreezePanes = False
End If
End With
End Sub
'Recovers the frozen state, exactly like it was when the first function was called
Private Sub recuperaLinhasCongeladas()
If Me.frozen_scenario Then
'Creating the frozen header again
Globals.ThisAddIn.Application.Goto(Me.range_freeze_begin, True)
Me.range_freeze_end.Select()
Globals.ThisAddIn.Application.ActiveWindow.FreezePanes = True
'Showing the same cell at the top
Globals.ThisAddIn.Application.Goto(Me.first_visible_cell_not_fixed, True)
Me.frozen_scenario = False
End If
End Sub

Excel 2010: how to use autocomplete in validation list

I'm using a large validation list on which a couple of vlookup() functions depend. This list is getting larger and larger. Is there a way to type the first letters of the list item I'm looking for, instead of manually scrolling down the list searching for the item?
I've done some Googling but this suggests that this is indeed possible in earlier versions of Excel, but not in Excel 2010. Hope you guys can help.
Here is a very good way to handle this (found on ozgrid):
Let's say your list is on Sheet2 and you wish to use the Validation List with AutoComplete on Sheet1.
On Sheet1 A1 Enter =Sheet2!A1 and copy down including as many spare rows as needed (say 300 rows total). Hide these rows and use this formula in the Refers to: for a dynamic named range called MyList:
=OFFSET(Sheet1!$A$1,0,0,MATCH("*",Sheet1!$A$1:$A$300,-1),1)
Now in the cell immediately below the last hidden row use Data Validation and for the List Source use =MyList
[EDIT] Adapted version for Excel 2007+ (couldn't test on 2010 though but AFAIK, there is nothing really specific to a version).
Let's say your data source is on Sheet2!A1:A300 and let's assume your validation list (aka autocomplete) is on cell Sheet1!A1.
Create a dynamic named range MyList that will depend on the value of the cell where you put the validation
=OFFSET(Sheet2!$A$1,MATCH(Sheet1!$A$1&"*",Sheet2!$A$1:$A$300,0)-1,0,COUNTA(Sheet2!$A:$A))
Add the validation list on cell Sheet1!A1 that will refert to the list =MyList
Caveats
This is not a real autocomplete as you have to type first and then click on the validation arrow : the list will then begin at the first matching element of your list
The list will go till the end of your data. If you want to be more precise (keep in the list only the matching elements), you can change the COUNTA with a SUMLPRODUCT that will calculate the number of matching elements
Your source list must be sorted
Here's another option. It works by putting an ActiveX ComboBox on top of the cell with validation enabled, and then providing autocomplete in the ComboBox instead.
Option Explicit
' Autocomplete - replacing validation lists with ActiveX ComboBox
'
' Usage:
' 1. Copy this code into a module named m_autocomplete
' 2. Go to Tools / References and make sure "Microsoft Forms 2.0 Object Library" is checked
' 3. Copy and paste the following code to the worksheet where you want autocomplete
' ------------------------------------------------------------------------------------------------------
' - autocomplete
' Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' m_autocomplete.SelectionChangeHandler Target
' End Sub
' Private Sub AutoComplete_Combo_KeyDown(ByVal KeyCode As msforms.ReturnInteger, ByVal Shift As Integer)
' m_autocomplete.KeyDownHandler KeyCode, Shift
' End Sub
' Private Sub AutoComplete_Combo_Click()
' m_autocomplete.AutoComplete_Combo_Click
' End Sub
' ------------------------------------------------------------------------------------------------------
' When the combobox is clicked, it should dropdown (expand)
Public Sub AutoComplete_Combo_Click()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim cbo As OLEObject: Set cbo = GetComboBoxObject(ws)
Dim cb As ComboBox: Set cb = cbo.Object
If cbo.Visible Then cb.DropDown
End Sub
' Make it easier to navigate between cells
Public Sub KeyDownHandler(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Const UP As Integer = -1
Const DOWN As Integer = 1
Const K_TAB_______ As Integer = 9
Const K_ENTER_____ As Integer = 13
Const K_ARROW_UP__ As Integer = 38
Const K_ARROW_DOWN As Integer = 40
Dim direction As Integer: direction = 0
If Shift = 0 And KeyCode = K_TAB_______ Then direction = DOWN
If Shift = 0 And KeyCode = K_ENTER_____ Then direction = DOWN
If Shift = 1 And KeyCode = K_TAB_______ Then direction = UP
If Shift = 1 And KeyCode = K_ENTER_____ Then direction = UP
If Shift = 1 And KeyCode = K_ARROW_UP__ Then direction = UP
If Shift = 1 And KeyCode = K_ARROW_DOWN Then direction = DOWN
If direction <> 0 Then ActiveCell.Offset(direction, 0).Activate
AutoComplete_Combo_Click
End Sub
Public Sub SelectionChangeHandler(ByVal Target As Range)
On Error GoTo errHandler
Dim ws As Worksheet: Set ws = ActiveSheet
Dim cbo As OLEObject: Set cbo = GetComboBoxObject(ws)
Dim cb As ComboBox: Set cb = cbo.Object
' Try to hide the ComboBox. This might be buggy...
If cbo.Visible Then
cbo.Left = 10
cbo.Top = 10
cbo.ListFillRange = ""
cbo.LinkedCell = ""
cbo.Visible = False
Application.ScreenUpdating = True
ActiveSheet.Calculate
ActiveWindow.SmallScroll
Application.WindowState = Application.WindowState
DoEvents
End If
If Not HasValidationList(Target) Then GoTo ex
Application.EnableEvents = False
' TODO: the code below is a little fragile
Dim lfr As String
lfr = Mid(Target.Validation.Formula1, 2)
lfr = Replace(lfr, "INDIREKTE", "") ' norwegian
lfr = Replace(lfr, "INDIRECT", "") ' english
lfr = Replace(lfr, """", "")
lfr = Application.Range(lfr).Address(External:=True)
cbo.ListFillRange = lfr
cbo.Visible = True
cbo.Left = Target.Left
cbo.Top = Target.Top
cbo.Height = Target.Height + 5
cbo.Width = Target.Width + 15
cbo.LinkedCell = Target.Address(External:=True)
cbo.Activate
cb.SelStart = 0
cb.SelLength = cb.TextLength
cb.DropDown
GoTo ex
errHandler:
Debug.Print "Error"
Debug.Print Err.Number
Debug.Print Err.Description
ex:
Application.EnableEvents = True
End Sub
' Does the cell have a validation list?
Function HasValidationList(Cell As Range) As Boolean
HasValidationList = False
On Error GoTo ex
If Cell.Validation.Type = xlValidateList Then HasValidationList = True
ex:
End Function
' Retrieve or create the ComboBox
Function GetComboBoxObject(ws As Worksheet) As OLEObject
Dim cbo As OLEObject
On Error Resume Next
Set cbo = ws.OLEObjects("AutoComplete_Combo")
On Error GoTo 0
If cbo Is Nothing Then
'Dim EnableSelection As Integer: EnableSelection = ws.EnableSelection
Dim ProtectContents As Boolean: ProtectContents = ws.ProtectContents
Debug.Print "Lager AutoComplete_Combo"
If ProtectContents Then ws.Unprotect
Set cbo = ws.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, DisplayAsIcon:=False, _
Left:=50, Top:=18.75, Width:=129, Height:=18.75)
cbo.name = "AutoComplete_Combo"
cbo.Object.MatchRequired = True
cbo.Object.ListRows = 12
If ProtectContents Then ws.Protect
End If
Set GetComboBoxObject = cbo
End Function
Building on the answer of JMax, use this formula for the dynamic named range to make the solution work for multiple rows:
=OFFSET(Sheet2!$A$1,MATCH(INDIRECT("Sheet1!"&ADDRESS(ROW(),COLUMN(),4))&"*",Sheet2!$A$1:$A$300,0)-1,0,COUNTA(Sheet2!$A:$A))
Excel automatically does this whenever you have a vertical column of items. If you select the blank cell below (or above) the column and start typing, it does autocomplete based on everything in the column.
As other people suggested, you need to use a combobox. However, most tutorials show you how to set up just one combobox and the process is quite tedious.
As I faced this problem before when entering a large amount of data from a list, I can suggest you use this autocomplete add-in . It helps you create the combobox on any cells you select and you can define a list to appear in the dropdown.
=OFFSET(NameList!$A$2:$A$200,MATCH(INDIRECT("FillData!"&ADDRESS(ROW(),COLUMN(),4))&"*",NameList!$A$2:$A$200,0)-1,0,COUNTIF($A$2:$A$200,INDIRECT("FillData!"&ADDRESS(ROW(),COLUMN(),4))&"*"),1)
Create sheet name as Namelist. In column A fill list of data.
Create another sheet name as FillData for making data validation list as you want.
Type first alphabet and select, drop down menu will appear depend on you type.