I am trying to go through a slicer in VBA, this is my code:
ActiveWorkbook.SlicerCaches("Slicer_Customer_Name1").ClearManualFilter 'Opens the slicer we want to focus on
With ActiveWorkbook.SlicerCaches("Slicer_Customer_Name1")
For countCustomer = 1 To 100
Sheet4.Cells(countCustomer, 3) = Sheet3.Cells(5, 1)
prevCustomer = countCustomer - 1
If countCustomer > 1 Then
.SlicerItems(countCustomer).Selected = True
.SlicerItems(prevCustomer).Selected = False
End If
Next countCustomer
End With
What I want to do is go through the slicer and print out the value in cell A5 for each different filtered value. I need it to complete code for a project where this is just the foundation.
Related
I'm writing some VBA code for a user form. The values are selected in a listbox on the left (LB_Participants). Then "select" is pressed and the values are copied to a listbox on the right (LB_Output). I then want VBA to go through all these items seperatly in the LB_Output and look up other associated data from another worksheet. Problem I'm having is that somethimes the values are not selected. I check it with a messagebox and from time to time its blank. Then no associated data can be retrieved ofcourse.
Before starting to fill in the userform, if I just click once on LB_Output (even without selecting any value) I don't have this problem. Many people will be using the userform so I don't want to explain tot them that they have to click first on the listbox before continuing... Is there something I'm not doing right?
Blank Msgbox
Dim ListCount As Integer
Dim z As Integer
ListCount = UserForm2.LB_Output.ListCount
For z = 0 To ListCount - 1
UserForm2.LB_Output.Selected(z) = True
TextString = UserForm2.LB_Output.Value
MsgBox (TextString)
'Split Participants into seperate names and copy them to data sheet
WArray() = Split(TextString, ";")
For Counter = LBound(WArray) To UBound(WArray)
Dim LRNames As Integer
If IsEmpty(Sheets("Data").Range("A1")) = True Then
LRNames = 0
Else
LRNames = Sheets("Data").Range("A" & Application.Rows.Count).End(xlUp).Row
End If
Strg = WArray(Counter)
Sheets("Data").Cells(LRNames + 1, 1) = Trim(Strg)
Next Counter
Next z
Not sure I understand, but think you want to loop through all the items in LB_Output and process them regardless if selected or not - all the selection was done in the other listbox and those items moved to LB_Output.
This does not explicitly select each item, simply gets data from it.
For z = 0 to UserForm2.LB_Output.Listcount -1
' If you want to select the item to show 'progress' through the list,
' uncomment ...
' LB_Output.listindex = z
' The next line will still work as is
TextString = UserForm2.LB_Output.List(z)
'// Do processing with this item
Next
I am working with a VB macro. Essentially what I am trying to do is for the macros to read the input and first determine whether or not a cells ID number matches the one in the row. Example: If row 1 has an ID of 1122 and rows 2,3,4 and 5 all match, I want the macro to read that and create a count in the NbrOfA cell. Once it realizes that there is not an ID match it moves on to the next ID and looks for matches of that ID number and continues to create a count. While it is doing this, I also need it to read from another column that has specific strings such as "open", "closed" ect. read that input, and create a separate row titled NbrofOpenA. Once it runs out of data, I then want to have a singular cell that shows the number of actions (NbrOfA) that match the ID number as well as the number of open actions (NbrOfOpenA).
Currently I receive the error: “compile error: sub or function not defined” highlighting the Set Cell(Sheet2.Cells(FirstRowOfI, 23) = NbrOfA
Attached in the excel sheet attached it shows 2 cells deleted. They will not actually be deleted, just wanted to give an idea of what I was looking for
Sub ACount()
Dim FirstRowofI
Dim NbrOfA as Integer
Dim NbrOfOpenA as Integer
Row = 2
Set FirstRowofI = (Sheet2.Cells.Range(Row, 14))
NbrOfA = 0
NbrOfOpenA = 0
If (Sheet2.Cells(Row, 14).Value <> "") Then
NbrOfA = 1
If (Sheet2.Cells(Row, 22) <> "Closed") Then
NbrOfOpenA = 1
Set Row = FirstRowofI
Row = Row + 1
Do While (Sheet2.Cells(Row, 14) = (Sheet2.Cells(FirstRowofI, 14)))
NbrOfOpenA = NbrOfOpenA + 1
If (Sheet2.Cells(Row, 22) <> "Closed" Then
NbrOfOpenA = NbrOfOpenA + 1
Range(Row).EntireRow.Delete
Return
End If
Set Cell(Sheet2.Cells(FirstRowofI, 23)) = NbrOfA
Set Cell(Sheet2.Cells(FirstRowofI, 24)) = NbrOfOpenA
Loop
End Sub
[1
Do you need VBA? You can easily achieve what you're looking for with formulas, heck even a Pivot Table! Here's an example with formulas:
I have 80 rows where the user can enter a predetermined value under column Ward. This unhides a button next to it. Upon clicking it, it empties the adjacent value and increments (+1) a particular cell in another sheet depending on the original value.
Currently, I have 80 ActiveX buttons next to the Ward cells that hides/unhides depending on the value of the Ward cells. I've noticed that adding more buttons slows down the spreadsheet because of the sheer volume of If Then statements I have.
If Range("F8").Value = 0 Then
Sheets("Admissions").EDAdmit1.Visible = False
Else
Sheets("Admissions").EDAdmit1.Visible = True
End If
If Range("L8").Value = 0 Then
Sheets("Admissions").ElecAdmit1.Visible = False
Else
Sheets("Admissions").ElecAdmit1.Visible = True
End If
If Range("F9").Value = 0 Then
Sheets("Admissions").EDAdmit2.Visible = False
Else
Sheets("Admissions").EDAdmit2.Visible = True
End If
If Range("L9").Value = 0 Then
Sheets("Admissions").ElecAdmit2.Visible = False
Else
Sheets("Admissions").ElecAdmit2.Visible = True
End If
.. and so on.
Not to mention the If Then statements I have for every button click.
Private Sub EDAdmit1_Click()
If Range("F8") = "ICU" Then
Worksheets("Overview").Range("AD11").Value = Worksheets("Overview").Range("AD11") + 1
ElseIf Range("F8") = "HDU" Then
Worksheets("Overview").Range("AF11").Value = Worksheets("Overview").Range("AF11") + 1
ElseIf Range("F8") = "DPU" Or Range("F8") = "Other" Then
Else
Col = WorksheetFunction.VLookup(Range("F8"), Range("U1:V27"), 2)
Worksheets("Overview").Range(Col).Value = Worksheets("Overview").Range(Col).Value + 1
End If
Range("F8").ClearContents
End Sub
Is there a more efficient way of doing this?
Admission List:
You could consider using "admit" hyperlinks in the cells next to the Ward selections: that way you only need one handler (Worksheet_FollowHyperlink in the worksheet module). Note you need to use Insert >> Hyperlink and not the HYPERLINK() formula-type links here (because formula-based links don't trigger the FollowHyperlink event).
You can ditch the hide/show code and instead use conditional formatting to change the link font color to hide the links when there's no Ward selected. If a user clicks on one of the hidden links then you can just do nothing.
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim rngSrc As Range, addr, ward
Set rngSrc = Target.Range '<< the cell with the link
ward = rngSrc.Offset(0, 1).Value '<< cell with Ward
'only do anything if a ward is selected
If Len(ward) > 0 Then
'find the cell to update
Select Case ward
Case "ICU"
addr = "AD11"
Case "HDU"
addr = "AF11"
Case "DPU", "Other"
addr = ""
Case Else
addr = Application.VLookup(ward, Me.Range("U1:V27"), 2, False)
End Select
'if we have a cell to update then
If Len(addr) > 0 Then
With Worksheets("Overview").Range(addr)
.Value = .Value + 1
End With
End If
rngSrc.Offset(0, 1).ClearContents
End If
rngSrc.Select '<< select the clicked-on link cell
' (in case the link points elsewhere)
End Sub
At the beginning of your code put this line:
Application.ScreenUpdating = False
this will disable all screen updates. Let your code do changes, and then enable screen updating, and all your changes will appear.
Application.ScreenUpdating = True
Disabling screen updating usually makes the execution of code faster.
I am trying to find a way to use Excel 2013 VBA to only select the Top 5 items in a pivot table. I have tried the following lines of code in an attempt to show only the Top 5 items:
Dim c
dim i as long
Worksheets("sheet1").PivotTables(1).PivotFields ("field1")
ActiveSheet.PivotTables(1).PivotFields("field1").CurrentPage = "(All)"
With ActiveSheet.PivotTables(1).PivotFields("field1")
c = 5
For i = .PivotItems.Count To 1 Step -1
If (c > 0) Then
.PivotItems(i).Visible = True
Else
.PivotItems(i).Visible = False
End If
c = c - 1
Next
End With
This is the code that the macro recorder gives me and does not work:
ActiveSheet.PivotTables("PivotTable5").PivotFilters. _
.PivotFields("field1") Add2 Type:=xlTopCount, _ DataField:=ActiveSheet.PivotTables("PivotTable5"). _
PivotFields("fied1"), Value1:=5
The code below works fine if there are no value ties for any of the values that are not in the Top 5 list. With our data set we are always going to ties in our Top 5 list.
With Workbooks(cFileName).Worksheets("sheet1")
.PivotTables(1).PivotFields("Field1").PivotFilters.Add2
xlTopCount, .PivotTables(1).PivotFields("Field1"), 5
End With
EDIT:
The pivot table list will show some items as being checked, but no data is associated with those values. The charts which are based on these pivot tables are blank and the following code selects only the bottom 5 values in the field as it was intended to do in it's original post.
With workbook.Worksheets("sheet1").PivotTables("PivotTable2").PivotFields
("Count of Description")
For Each WS In ActiveWorkbook.Worksheets
For Each pvt In WS.PivotTables
c = 5
For i = .PivotItems.Count To 1 Step -1
If (c > 0) Then
.PivotItems(i).Visible = True
Else
.PivotItems(i).Visible = False
End If
c = c - 1
Next
Next
Next
End With
I finally figured this one out. The best way to do it just in case anyone else is wondering, is to record a macro while you:
Select the cell in which you want to start seeing data. In my case it was "B10". This will be different for everyone else depending on where your pivot table data is.
Press the SHIFT + END + DOWN ARROW Keys to go down to the bottom of the used range.
Select all the rows to hide.
Right Click on the values to hide.
Select "Filter" from the list.
Click on "Hide selected items".
Below is the code that I will refer to in the future.
Application.Goto reference:=Workbooks("File").Sheets("Sheet1").Range("B10")
If IsEmpty(Range("B11").value) = False Then
Range("B10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete
Else
End If
I have working code which selects single items from a slicer, however it doesn't work for multiple items.
The selection is set up by reading which cells in a range are in bold, and populating an array of strings, STP(46), populating up until STP(k). This works fine.
Then the code is supposed to deselect all items in the slicer which aren't in STP, and select those which are. This works for one selection but not for multiple selections - it erroneously selects all items up until the last item to be selected.
With ActiveWorkbook.SlicerCaches("Slicer_STP_Name")
For i = 1 To .SlicerItems.Count
For j = 1 To k
If .SlicerItems(i).Selected And .SlicerItems(i).Caption <> STP(j) Then .SlicerItems(i).Selected = False
Next j
Next i
For i = 1 To .SlicerItems.Count
For j = 1 To k
If .SlicerItems(i).Caption = STP(j) Then .SlicerItems(i).Selected = True: Exit For
Next j
Next i
End with
So instead of selecting, say, the 2nd and 4th item in the slicer, it selects the 1st, 2nd, 3rd, 4th, and deselects the rest.
I need to use a looped technique like this because I need to be able to use this code with multiple slicers with different cache names but the same list of items.
I've looked everywhere, and the code above is even from a solution from another question on here. Any help greatly appreciated!
You can use a dictionary to make the process a little more smooth
With ActiveWorkbook.SlicerCaches("Slicer_test_id")
Dim i
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Selected And Not stp.Exists(.SlicerItems(i).Caption) Then
.SlicerItems(i).Selected = False
End If
Next i
For i = 1 To .SlicerItems.Count
If stp.Exists(.SlicerItems(i).Caption) Then
.SlicerItems(i).Selected = True
End If
Next i
End With
I'm not totally clear on why you need the first loop. I'm reading "Then the code is supposed to deselect all items in the slicer which aren't in STP, and select those which are." as "select only those otems in STP and deselect all others" which this reduced code will do:
With ActiveWorkbook.SlicerCaches("Slicer_test_id")
Dim i
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = stp.Exists(.SlicerItems(i).Caption)
Next i
End With
populating the Dictionary is super easy
Dim stp As New Dictionary
stp.Add "73148", "73148"
stp.Add "73150", "73150"
stp.Add "73159", "73159"
You need to reference the Microsoft Scripting Runtime
note that if you don't see Microsoft Scripting Runtime in the list you can Browse to C:\Windows\SysWOW64\scrrun.dll