Remove formulas from all worksheets in Excel using VBA - excel

I'm having toubles removing formulas from cells in Excel and keep only the value (in case there is a number). The problem is due to the fact that there are also pivot tables (and also GETPIVOTDATA cells) within the different spreadsheets.
I am currently trying this code but it only works on normal spreadsheets:
Sub fun()
Dim ws As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim pc As PivotCell
For Each ws In ThisWorkbook.Worksheets
ws.Activate
With ws.UsedRange
.Value = .Value
End With
Next ws
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
For Each pf In pt.PivotFields
For Each pi In pf.PivotItems
pi.Value = pi.Value
Next pi
Next pf
Next pt
Next ws
End Sub
Could you help me to adapt the code so that every cell will be set to value?!

Option Explicit
Sub test1()
Dim ws As Worksheet, a, area As String
For Each ws In ThisWorkbook.Worksheets
a = ws.UsedRange
area = ws.UsedRange.Address
ws.Cells.ClearContents
ws.Range(area) = a
Next
End Sub

Related

VBA clear content in cell range, except for sheet 1

How should write the code so that it skips sheet1?
Sub Clear_All()
Dim Ws As Worksheet
For Each Ws In ActiveWorkbook.Worksheets
Ws.Range("A11:F800").ClearContents
Next Ws
End Sub
The standard way would be something like
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name <> "Sheet1" Then Ws.Range("A11:F800").ClearContents
Next Ws
but, if Sheet1 were already the left-most tab in the workbook then you could do so more simply
Dim i as Long
For i = 2 to Worksheets.Count
Worksheets(i).Range("A11:F800").ClearContents
Next i

vba same filter for all pivot charts

I have a problem with my code. I would like to use the code to set the same filters for all pivot charts in the workbook. Specifically, to set the same year in all pivot charts in the whole workbook. Can you help me, please. Thank you
Sub Makro2()
Dim pf As PivotField
Dim sht As Worksheet
Dim pvt As PivotTable
Dim pch As ChartObject
For Each sht In ThisWorkbook.Worksheets
For Each pch In sht.ChartObjects
Set pf = pvt.PivotFields("[Ucetni obdobi].[Rok].[Rok]")
pf.VisibleItemsList = Array("[Ucetni obdobi].[Rok].&[2017]")
Next pch
Next sht
End Sub
Dim ws As Worksheet
Dim pivot As PivotTable
For Each ws In ThisWorkbook.Worksheets
For Each pivot In ws.PivotTables
With pivot.PivotFields("DataColumn1")
.PivotItems("5000").Visible = False
End With
Next pivot
Next sht

VBA to refresh all sheets in a workbook excluding only one Sheet

Sample Heading Hello I have pivot tables in 6 sheets of my workbook out of 9 and one sheet (Sorted) has columns arranged in a particular order but it doesn't have pivot tables. I want to refresh sheets with Pivot only. I have used the below VBA but it rearranges the columns in the Sorted worksheet. Below is the code
Sub RefreshAllPivotTables()
Dim PT As PivotTable
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
For Each PT In WS.PivotTables
PT.RefreshTable
Next PT
Next WS
End Sub
This is a possible way to exclude one sheet:
Sub RefreshAllPivotTables()
Dim PT As PivotTable
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "Sorted" Then
For Each PT In WS.PivotTables
PT.RefreshTable
Next PT
End If
Next WS
End Sub

(VBA) apply to all, except one specific

Hi everyone i made a button on excel using VBA modules,The code works on the active sheet but what im looking for is to be applied to more sheets, not just the active sheet where the button is placed.
Sub Botón1_Haga_clic_en()
Call Worksheet_Calculate
End Sub
'apply cells colors from single-cell formula dependencies/links
Private Sub Worksheet_Calculate()
Dim Cel As Range
Dim RefCel As Range
On Error Resume Next
For Each Cel In ActiveSheet.UsedRange
If Cel.HasFormula Then
Set RefCel = Evaluate(Mid(Cel.Formula, 2))
Cel.Interior.Color = RefCel.Interior.Color
End If
Next Cel
End Sub
Try the code below :
Option Explicit
Sub Botón1_Haga_clic_en()
Dim wsName As String
Dim ws As Worksheet
wsName = ActiveSheet.Name
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name Like wsName Then '<-- is worksheet's name doesn't equal the ActiveSheet's
ApplyCellColors ws ' <-- call you Sub, with the worksheet object
End If
Next ws
End Sub
'=======================================================================
'apply cells colors from single-cell formula dependencies/links
Private Sub ApplyCellColors(ws As Worksheet)
Dim Cel As Range
Dim RefCel As Range
On Error Resume Next
For Each Cel In ws.UsedRange
If Cel.HasFormula Then
Set RefCel = Evaluate(Mid(Cel.Formula, 2))
Cel.Interior.Color = RefCel.Interior.Color
End If
Next Cel
End Sub
Your problem can be translated to something like How to loop over all sheets and ignore one of them?
This is a good way to do it:
Option Explicit
Option Private Module
Public Sub TestMe()
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If wks.name = "main" Then
Debug.Print "Do nothing here, this is the active sheet's name"
Else
Debug.Print wks.name
End If
Next wks
End Sub
Pretty sure, that you should be able to fit it in your code.

VBA For each pivot within workbook update datasource range

I am trying to loop though each worksheet in my workbook and reset all pivot data ranges to range("D1_Data") before refreshing.
Currently getting a Runtime error '1004' with the below code and somewhat stuck, any ideas?
Note that "TemplateWB" has been pre-set else where in my code as a workbook which the code is currently operating in.
'Set Dim
Dim PT As PivotTable
Dim WS As Worksheet
'Set D1_Data
TemplateWB.Sheets("Data_1").Range(Cells(1, 1), Cells(NewLastRow, NewLastColumn + 4)).Name = "D1_Data"
For Each WS In TemplateWB.Worksheets
For Each PT In WS.PivotTables
With PT.PivotCache
.SourceData = Range("D1_Data").Address(True, True, xlR1C1, True)
.Refresh
End With
Next PT
Next WS
Try the code below (I tested it on multiple Pivot Tables across different worksheets and it worked).
Option Explicit
Sub AutoRefreshPivot()
Dim WS As Worksheet
Dim PT As PivotTable
Dim PTCache As PivotCache
Dim NewLastRow As Long, NewLastColumn As Long
Dim TemplateWB As Workbook
' values for my internal testing
'Set TemplateWB = ThisWorkbook
'NewLastRow = 11
'NewLastColumn = 4
'Set D1_Data
TemplateWB.Sheets("Data_1").Range(Cells(1, 1), Cells(NewLastRow, NewLastColumn + 4)).Name = "D1_Data"
For Each WS In TemplateWB.Worksheets
For Each PT In WS.PivotTables
' set Pivot Cache to updated data source range (per each Pivot Table)
Set PTCache = TemplateWB.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=Range("D1_Data").Address(True, True, xlR1C1, True), _
Version:=xlPivotTableVersion14)
With PT
.ChangePivotCache PTCache
' .Refresh
End With
' need to clear the cache every time after being used for a Pivot table
Set PTCache = Nothing
Next PT
Next WS
End Sub

Resources