I have a slicer that contains items from a pivot table. My users wants the ability to hide certain slicer items even though these items contains data. Is there a way to hide sliceritems via VBA code?
Why not just filter them out? If this is an OLAP PivotTable, see Pivot Table filter out only 1 option
If this is a "Traditional" PivotTable, then you can use a variation of the code I posted at Pivotfields multiple filter
Here's some amended code:
Sub FilterSlicer_Inverse()
Dim slr As Slicer
Dim sc As SlicerCache
Dim si As SlicerItem
Dim i As Long
Dim vItem As Variant
Dim vSelection As Variant
Dim pt As PivotTable
Set sc = ActiveWorkbook.SlicerCaches("Slicer_test")
vSelection = Array("1", "2") <= List the items you want to hide in here
For Each pt In sc.PivotTables
pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed
Next pt
With sc
.ClearAllFilters
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vSelection
.SlicerItems(vItem).Selected = False
Next vItem
On Error GoTo 0
End With
For Each pt In sc.PivotTables
pt.ManualUpdate = False
Next pt
End Sub
Note that it doesn't matter if you change the PivotItems or the SlicerItems...you get the same result.
Related
I am trying to update an OLAP pivotfilter with the value of another cell (not in a pivot table).
The code I have is as follows:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when
'cell C1 or C2 is touched
If Intersect(Target, Range("C1:C2")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewStock As String
'Here you amend to suit your data
Set pt = ActiveSheet.PivotTables("PivotFilter")
'The activesheet is named "Top1_Value"
Set Field = pt.PivotFields("[StockCode].[Stock Code_SKU].[Stock Code_SKU]")
NewStock = ActiveSheet.Range("C1").Value
'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.VisibleItemsList = NewStock
pt.RefreshTable
End With
End Sub
Any assistance to resolve would be appreciated.
I want to make an Excel workbook that I have much quicker.
I have a big product database with the product names, quantities, delivery number and delivery date (ProductDB). I put in another sheet the products that I have sold (product names and quantity sold) and want to filter and copy those that are corresponding from the database so I can calculate in the second step the remaining quantity and past the remaining quantity to the database.
Everything is working well and the calculation is good. The only thing is, the Advancedfilter xlfiltercopy option is too slow if I have to input 5000 lines of product names.
I have heard that arrays are much faster. How could I do that? The current way I do it is like this:
Sub UseFilter()
Application.ScreenUpdating = False
Sheet1.Range("G1:Z100000").Cells.Delete
Dim lastrow As Long, c As Range
Dim myrange As Range
Dim rngCell As Range
Dim wksSheet As Worksheet
Dim wksSheetDB As Worksheet
lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
Sheet1.Columns("G").NumberFormat = "0"
Filter product codes from the database according to sold product codes:
Set myrange = Range("A1:A" & lastrow)
For Each c In myrange
If Len(c.Value) <> 0 Then
ThisWorkbook.Worksheets(Worksheets.Count).Columns("A:D").AdvancedFilter xlFilterCopy, _
Sheet1.Range("A1:A" & lastrow), Sheet1.Range("G1"), False
End If
Next
Sort the filtered list first by product code, then by the delivery number:
Dim lngRowMax As Long
Dim wsf As WorksheetFunction
With Sheet1
lastrow = Cells(Rows.Count, 8).End(xlUp).Row
Range("G1:J" & lastrow).Sort Key1:=Range("G1:G" & lastrow), _
Order1:=xlAscending, Key2:=Range("I1:I" & lastrow), _
Order2:=xlAscending, Header:=xlYes, DataOption1:=xlSortTextAsNumbers
Set wsf = Application.WorksheetFunction
lngRowMax = .UsedRange.Rows.Count
End With
I'm only interested in filtering and copying of the corresponding product information (name (A), quantity (B), delivery nr (C) and date (D)). Does anyone know how I can do that?
Thank you very much in advance. I'm really looking forward for a solution that improves the pace of the file. Currently it is unbelievably slow.
i had the same problem with advanced filter being so slow. you might want to consider using dictionary. for my 2 spreadsheets i wanted to compare i made 2 dictionaries and compared the values and it was so amazingly fast. dictionaries are really easy and a simple google search you can find a ton of tutorials and examples. good luck.
There is a possible solution with dictionaries, but I have only one small issue. I will explain after the code:
'Count num rows in the database
NumRowsDB = ThisWorkbook.Worksheets(Worksheets.Count).Range("A2", Range("A2").End(xlDown)).Rows.Count
' --------------------- SAVE DATABASE DATA -----------------------
'Dictionary for all DB data
Set dbDict = CreateObject("Scripting.Dictionary")
Set dbRange = Range("A2:A" & (NumRowsDB + 1))
For Each SKU In dbRange
If Len(SKU.Value) <> 0 Then
' check if the SKU allready exists, if not create a new array list for that dictionary entry
' a list is necessary because there can be multiple entries in the db range with the same SKU
If Not dbDict.Exists(CStr(SKU.Value)) Then
Set prodList = CreateObject("System.Collections.ArrayList")
dbDict.Add CStr(SKU.Value), prodList
End If
' for this specific product code, save the range where the product information is saved in the dictionary
rangeStr = "A" & SKU.Row & ":D" & SKU.Row
dbDict(CStr(SKU.Value)).Add (rangeStr)
End If
Next
' ----------- READ SALE/Reverse/Consumption INFO ------------------
NumRowsSale = Range("A2", Range("A2").End(xlDown)).Rows.Count
Set saleRange = Range("A2:A" & (NumRowsSale + 1))
Dim unionRange As Range
For Each sale In saleRange
' check if the SKU for the sale exists in db
If Len(sale.Value) <> 0 And dbDict.Exists(CStr(sale.Value)) Then
For Each dbRange In dbDict(CStr(sale.Value))
If unionRange Is Nothing Then
Set unionRange = Range(dbRange)
Else
Set unionRange = Union(unionRange, Range(dbRange))
End If
Next
End If
Next
unionRange.Copy Destination:=Range("G2") 'copy all received ranges to G2
Set dbDict = Nothing
The line "NumRowsDB = ThisWorkbook.Worksheets(Worksheets.Count).Range("A2", Range("A2").End(xlDown)).Rows.Count" is not working. I have to refer to another sheet (the last sheet which is the current database) to get the data. What is the problem that I cannot refer to another sheet in the same workbook?
Thank you for your suggestions.
I'm trying to populate a series of textboxes with random value from a column.
i get the first textbox filled then it returns run time error 3021 - no current record.
i checked the values and the record I'm trying to retrieve doesn't exceed recordcount for the table.
Debug colours rs.move randomrecord.
Dim rs As DAO.Recordset
Dim recordCount As Long
Dim randomRecord As Long
Set rs = CurrentDb.OpenRecordset("SELECT * FROM besede")
rs.MoveLast
rs.MoveFirst
recordCount = rs.recordCount - 1
MsgBox recordCount
Randomize
Dim i As Integer
For i = 1 To 10
randomRecord = Int((recordCount) * Rnd)
rs.Move randomRecord
Controls("t" & i).SetFocus
Controls("t" & i) = rs!test
Next
You are moving the cursor from the current position, so eventually you are trying to read a record at the end of the recordset. Use
rs.MoveFirst before rs.Move randomRecord
to move from the beginning of the recordset.
Check Office Dev Center for more background information on Recordset.Move.
Suppose I have Sheet(1) in an excel. Now i do also have 2500 rows which has data for the columns from A to BO.Now I want the data to copy from these sheet to another sheet of the same Excel file for 2500 rows but not the whole the columns,rather i need only columns from A to AA data to copy to the new sheet.
So how to frame it using VBscript?
Please help me.
How to copy rows of from one sheet to another sheet using vbscript
To copy data from one sheet to another you can use the Copy en PasteSpecial commands. To do this with a .vbs script do the following:
' Create Excel object
Set objExcel = CreateObject("Excel.Application")
' Open the workbook
Set objWorkbook = objExcel.Workbooks.Open _
("C:\myworkbook.xlsx")
' Set to True or False, whatever you like
objExcel.Visible = True
' Select the range on Sheet1 you want to copy
objWorkbook.Worksheets("Sheet1").Range("A1:AA25").Copy
' Paste it on Sheet2, starting at A1
objWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial
' Activate Sheet2 so you can see it actually pasted the data
objWorkbook.Worksheets("Sheet2").Activate
If you want to do this in Excel with a VBS macro you can also call the copy and paste methods. Only your workbook object will be something like ActiveWorkbook
This code is Working fine. Just Copy and paste it.
Dim CopyFrom As Object
Dim CopyTo As Object
Dim CopyThis As Object
Dim xl As Object
xl = CreateObject("Excel.Application")
xl.Visible = False
CopyFrom = xl.Workbooks.Open("E:\EXCEL\From.xls")
CopyTo = xl.Workbooks.Open("E:\EXCEL\To.xls")
For i = 0 To 1
''To use a password: Workbooks.Open Filename:="Filename", Password:="Password"
If i = 0 Then
CopyThis = CopyFrom.Sheets(1)
CopyThis.Copy(After:=CopyTo.Sheets(CopyTo.Sheets.Count))
CopyTo.Sheets(3).Name = "Sheet3"
Else
CopyThis = CopyFrom.Sheets(2)
CopyThis.Copy(After:=CopyTo.Sheets(CopyTo.Sheets.Count))
CopyTo.Sheets(4).Name = "Sheet4"
End If
Next
CopyTo.Sheets(1).Activate()
CopyTo.Save()
'CopyTo.SaveAs("E:\EXCEL\Check.xls")
xl.Quit()
Sub buildMissingSheet(strMissingSheet) 'Just passing the missing sheet name in
' Master Sheet code
' Working on creating the "Master Sheet" at this time...May need to seperate the the code a little.
Dim GetRows1 As Worksheet
Dim GetRows2 As Worksheet
Dim PutRows As Worksheet
Dim sglRowNum As Single, i%
If strMissingSheet = strMASTERSHEET Then ' Create the strMASTERSHEET
Set GetRows1 = Sheets(strRAWDATA) ' These two sheets could be missing but will code around that later.
Set GetRows2 = Sheets(strDATAWITH) ' The two sheets I am getting rows from
' Just creating a new worksheet here assuming it is missing
Worksheets.Add(After:=Worksheets(5)).Name = strMissingSheet
Set PutRows = Sheets(strMissingSheet) ' Missing sheet must be created before declaring.
PutRows.Select 'Select the sheet being built.
With Cells(1, 1)
.Value = strRAWDATA 'Not copying rows here but left it in this example anyway
.AddComment
.Comment.Visible = False
.Select
.Comment.Text Text:= _
Chr(10) & "Name of sheet including header and the last 32 entries at the time this sheet was updated."
End With
'Here is where we copy the whole row from one sheet to the other.
GetRows1.Rows(1).Copy PutRows.Rows(2) 'Copy header row from existing sheet to "Master Sheet" for instance.
GetRows1.Select
sglRowNum = ReturnLastRow(ActiveSheet.Cells) 'return last row with data on active sheet
' I wanted the last few rows of data "32 rows" so found the end of the sheet this code can be found on the internet in several places including this site.
'Now the code you may have been looking for move 32 row of data from one sheet to another.
For i = 1 To 32 'Start at row 3 on the Put sheet after sheet name and header.
GetRows1.Rows(sglRowNum - (32 - i)).Copy PutRows.Rows(i + 2)
Next i
end sub
I'm currently doing automation testing and need to write a dynamic value to an existing excel document in a specific column, this is what I have so far. Forgive I'm a novice
Sub WriteTRNtoExcelDoc
Dim fileName, sheetName
fname = "<Path_To_The_File>"
sheetName = "Sheet1"
Set app = Sys.OleObject("Excel.Application")
Set book = app.Workbooks.Open(fname)
Set sheet = book.Sheets(sheetName)
' What do I do next to add a value to a specific column or cell in this
' spreadsheet?
End Sub
Thanks in advance!
You create an Excel instance in a VBScript with
CreateObject("Excel.Application")
An already running Excel instance can be grabbed with
GetObject(, "Excel.Application")
In a worksheet you can access cells by using the Cells property:
Set app = CreateObject("Excel.Application")
app.Visible = True
Set book = app.Workbooks.Open(fname)
Set sheet = book.Sheets(sheetName)
sheet.Cells(2,3).Value = "foo"
Edit: If you need to find the first empty cell in a given column, you can use something like this:
row = 1
Do Until IsEmpty(sheets.Cells(row, 3).Value)
row = row + 1
Loop
sheet.Cells(row, 3).Value = RemPropValue