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

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.

Related

How to hide cell rows in Excel

Thanks in advance for your help. I have been working on this for a few days now and have tried a few different options. What I need done is to hide specific rows of an excel sheet based on the contents of an active X dropdown. I have indexed the dropdown to a cell and every time the user changes the dropdown selection, the indexed cell contains their selection as either text or number (whichever makes it easiest to code - I've been trying both). I want to keep the code as close to how it is at the moment if possible. I'm sure there are shorter/ more convenient methods, but I just want this over. I think the issue is that when the user selects a new option from the dropdown, the macro isnt refreshing and showing ALL rows again before it begins to hide the new rows. As a result, I just end up with a whole bunch of hidden rows based on what was originally selected. I hope that makes sense.
See the code below for what I've already tried. I also tried this one too, but had the same issue (that the macro wasnt refreshing and showing ALL rows before applying another Hide function)
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Activate
If Not Application.Intersect(Range("U13"), Range(Target.Address)) Is Nothing Then
Select Case Target.Value
Case Is = "Brand Health": Rows("19:39").EntireRow.Hidden = True
Rows("40:60").EntireRow.Hidden = False
Case Is = "Brand Imagery": Rows("38:60").EntireRow.Hidden = True
Rows("61:81").EntireRow.Hidden = False
Case Is = "NPS": Rows("30:82").EntireRow.Hidden = True
Rows("83:102").EntireRow.Hidden = False
Case Is = "Talent": Rows("35:103").EntireRow.Hidden = True
Rows("104:126").EntireRow.Hidden = False
Case Is = "Shows": Rows("37:127").EntireRow.Hidden = True
Rows("128:148").EntireRow.Hidden = False
End Select
End If
End Sub
Private Sub Worksheet_Change(ByVal Target`enter code here` As Range)
Sheets("Brand Tracking Dashboard").Rows("1:1000").EntireRow.Hidden = False ' Move this to the top
If Target.Address = ("$U$13") And Target.Value = 1 Then
Sheets("Brand Tracking Dashboard").Rows("19:39").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("59:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 2 Then
Sheets("Brand Tracking Dashboard").Rows("43:63").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("80:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 3 Then
Sheets("Brand Tracking Dashboard").Rows("32:84").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("101:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 4 Then
Sheets("Brand Tracking Dashboard").Rows("37:106").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("121:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 5 Then
Sheets("Brand Tracking Dashboard").Rows("37:129").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("145:1000").EntireRow.Hidden = True
End If
End Sub
What should happen is that after the user makes a selection, I guess the logic should be that the sheet is told to show ALL rows before applying the hide line command.
You are almost there - your guess was right. You just need to unhide all the rows before you hide the right ones based on the selection.
The first sub you posted is trying to do some unhiding, but it's only unhiding a few rows - and as you can't control what order the user selects the values in, it's probably trying to unhide the wrong ones. (Work through what happens if a user selects "Brand Health" followed by "Shows").
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
On Error GoTo errHandler
Application.ScreenUpdating = False
Set ws = Target.Worksheet
If Not Application.Intersect(ws.Range("U13"), Range(Target.Address)) Is Nothing Then
ws.Rows("19:148").Hidden = False 'edit this to include all the rows that could be hidden
Select Case Range("U13").Value
Case Is = "Brand Health"
ws.Rows("19:39").Hidden = True
Case Is = "Brand Imagery"
ws.Rows("38:60").Hidden = True
Case Is = "NPS"
ws.Rows("30:82").Hidden = True
Case Is = "Talent"
ws.Rows("35:103").Hidden = True
Case Is = "Shows"
ws.Rows("37:127").Hidden = True
End Select
End If
Application.ScreenUpdating = True
Exit Sub
errHandler:
Application.ScreenUpdating = True
End Sub
I've made a few other improvements:
ActiveSheet.Activate wasn't doing anything
You shouldn't rely on a particular sheet being the active one - what if the user changes it halfway through your macro? So I get the right worksheet at the start and use that throughout (make sure we are always working on the correct sheet)
Target could be a range of cells; you are only interested in the value of U13 so make that the condition for the Select Case
it's neater and faster to turn off screen updating - making sure it always gets turned on afterwards (even if there's an error).
Rows("xx:yy") returns whole rows so there's no need for EntireRow

Trigger macro with change in different worksheet

Apologies any incorrect terms, this is the first time I am trying to code a macro. I currently have the following code running:
Private Sub Worksheet_Deactivate()
'Alpha Show / Hide
If Sheets("Project_selection").Range("D4") = Range("C2") Then
Sheet3.EnableCalculation = True
ElseIf Sheets("Project_selection").Range("D4") = "All" Then
Sheet3.EnableCalculation = True
Else
Sheet3.EnableCalculation = False
End If
End Sub
which has been cobbled together from other codes and google. It works, but only when I move out of the sheet, which I think is being driven by the first line.
I would actually like it to activate when the Cell D4 in the 'Project_selection' sheet (a separate sheet to the one the code is on) gets changed - does anyone know how I would do that? I have seen references to worksheet_change, but I do not understand how one defines the target/range to get the appropriate reference.
Hope that makes sense and thanks in advance!
If you were to place the following code under the sheet (Project_selection), it would fire that event every time a change has happened in Cell D4:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Project_selection")
If Target.Address = "$D$4" Then
If ws.Range("D4") = ws.Range("C2") Then
Sheet3.EnableCalculation = True
ElseIf ws.Range("D4") = "All" Then
Sheet3.EnableCalculation = True
Else
Sheet3.EnableCalculation = False
End If
End If
End Sub

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 multiple checkboxes to control multiple pivot tables

again I need little help which I will greatly appreciate.
Basically, on my dashboard page I have couple of checkboxes that control numerous of pivot tables in the background.
I have checkboxes that are called "definite", "tentative", "pending,", ... and also corresponds to values in pivot fields.
and I have numerous of pivot tables called: "Hidden_1" or "Hidden_2" in different sheets but all with the same structure.
My idea was that If someone checked "definite", it will be selected in all pivot pivot tables in fields called "Status". If someone "unchecked" this checkbox, the pivots will react.
To do so I used a code that I create before and it was working well:
Sub checkbox1()
Application.ScreenUpdating = False
On Error Resume Next
Dim pt As PivotTable, wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
For Each pt In wks.PivotTables
With pt
If .Name = "Hidden_1" Or .Name = "Hidden_2" Then
.PivotFields("Status").CurrentPage = "definite"
End If
End With
Next pt
Next wks
Application.ScreenUpdating = True
End Sub
However, this code selects only one value, so I can't have selected both "definite" and "pending" if someone checked those boxes. Right now all checkboxes has a separate code assigned where only .CurrentPage = "checkboxname" was changed..
I have two questions:
1) what is the best way to select multiple values. E.g. if checked boxes "definite" and "pending" are checked, pivot tables should have selected two values "definite" and "pending" selected in the "Status" field
2) what is the best way to "dis-select" the value? Right now, my procedure checkbox1 is running everytime that the checkbox is clicked. And I want it to run only when I am "checking" it.
Right now I am trying to link the checkbox with cell, e.g. "definite" has H10, so my code starts with the line:
If Range("H10").Value = True Then
'code to select the value in "Status" field
Else
'code to unselect the value in "Status" field
End If
I should also noted that I couldn't use ActiveX Checkbox because I had error: "cannot insert object" and I used form controls. I read that this error is somehow connected with a patch that I have installed.
Thank you all for your help,
Matt
I worked on it and found such a solution:
Sub checkbox1()
Dim choice1, choice2, choice3, choice4, choice5, choice6, choice7
Dim oPI As PivotItem
Dim pt As PivotTable, wks As Worksheet
If Sheets("Hidden").Range("B6").Value = "True" Then
choice1 = "Definite"
End If
If Sheets("Hidden").Range("B7").Value = "True" Then
choice2 = "Tentative"
End If
If Sheets("Hidden").Range("B8").Value = "True" Then
choice3 = "Hold/Option"
End If
If Sheets("Hidden").Range("B9").Value = "True" Then
choice4 = "Pending"
End If
If Sheets("Hidden").Range("B10").Value = "True" Then
choice5 = "Waitlist"
If Sheets("Hidden").Range("B11").Value = "True" Then
choice6 = "Lost"
End If
If Sheets("Hidden").Range("B12").Value = "True" Then
choice7 = "Cancelled"
End If
Sheets("Hidden_pivot1").PivotTables("Hidden_1").PivotFields("SalesStatus").ClearAllFilters
Sheets("Hidden_pivot1").PivotTables("Hidden_3").PivotFields("SalesStatus").ClearAllFilters
Sheets("Hidden_pivot2").PivotTables("Hidden_2").PivotFields("SalesStatus").ClearAllFilters
Sheets("Hidden_pivot2").PivotTables("Hidden_4").PivotFields("SalesStatus").ClearAllFilters
For Each wks In ActiveWorkbook.Worksheets
For Each pt In wks.PivotTables
With pt
If .Name = "Hidden_1" Or .Name = "Hidden_2" Or .Name = "Hidden_3" Or .Name = "Hidden_4" Then
For Each oPI In pt.PivotFields("SalesStatus").PivotItems
Select Case oPI.Name
Case choice1, choice2, choice3, choice4, choice5, choice6, choice7
Case Else
oPI.Visible = False
End Select
Next
End If
End With
Next pt
Next wks
End Sub
This work but is so slow. It would be better if the macro could add and delete those items, instead of re-creating the entire choice.

Deselect all items in a pivot table using vba

Can some quicly explain the way to deselect all items in a newly created pivot table so that I can go back and select only one or two items? I tried the following:
.PivotItems("(Select All)").Visible = False
Thanks.
This is probably the closest you can get to what you want:
Dim i As Long
.PivotItems(1).Visible = True
For i = 2 To .PivotItems.Count
.PivotItems(i).Visible = False
Next
This will make the very first option the only selected option (assuming this is within a with that points to the pivotfield). If you know what you want before hand... modify accordingly.
I've found that looping through each data item takes a lot of time, what you can do if you want to filter on a single item in a pivot without looping through all items is use the following code:
ActiveSheet.PivotTables("Your Pivot Name").PivotFields("Your Field Name").ClearAllFilters
ActiveSheet.PivotTables("Your Pivot Name").PivotFields("Your Field Name").PivotFilters.Add _
Type:=xlCaptionEquals, Value1:="Your string here"
this is basically a label filter but it worked for me.
Check the following out. Select data for specific field name. Please do note that you have to at least select one item by default. And also do not forget that if you want to hide items, Only contiguous items in a PivotTable Field can be hidden. Perhaps at page load, or worksheet open or any of your other sub trigger, you could select a particular items to be selected based on a specific field. Then allow your code to proceed with anything else.
Sub specificItemsField()
Dim pf As PivotField
Dim pi As PivotItem
Dim strPVField As String
strPVField = "Field Name"
Set pt = ActiveSheet.PivotTables(1)
Set pf = pt.PivotFields(strPVField)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
pf.AutoSort xlManual, pf.SourceName
For Each pi In pf.PivotItems
pi.Visible = True
Next pi
pf.AutoSort xlAscending, pf.SourceName
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
This is how I do for custom filter selection. May be slower due to double looping.
Dim toSelect(1 To 3) As String
toSelect(1) = "item1"
toSelect(2) = "item2"
toSelect(3) = "item3"
For Each pvItem In objField.PivotItems
For Each st In toSelect
If pvItem.Value = st Then
pvItem.Visible = True
Exit For
Else
pvItem.Visible = False
End If
Next
Next
Well.
Because you have not how to hide all, because, always you need to have 1 item visible
I do this:
I start hiding the first field, and before go to the next, i show all fields i need visible, then, i go to the secont item, and hide, and again show all items i want, and so on. Then, always will be visible any field, and wont have error.
After the loop, i again try to show all fields i want.
With ActiveSheet.PivotTables("TablaD2").PivotFields("Entity")
Dim i As Long
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = False
.PivotItems("ARG").Visible = True
.PivotItems("BRL").Visible = True
.PivotItems("GCB").Visible = True
.PivotItems("MEX").Visible = True
Next
.PivotItems("ARG").Visible = True
.PivotItems("BRL").Visible = True
.PivotItems("GCB").Visible = True
.PivotItems("MEX").Visible = True
End With