Even we can refresh particular connection and in turn it will refresh all the pivots linked to it.
For this code I have created slicer from table present in Excel:
Sub UpdateConnection() Dim ServerName As String Dim ServerNameRaw As String Dim CubeName As String Dim CubeNameRaw As String Dim ConnectionString As String ServerNameRaw = ActiveWorkbook.SlicerCaches("Slicer_ServerName").VisibleSlicerItemsList(1) ServerName = Replace(Split(ServerNameRaw, "[")(3), "]", "") CubeNameRaw = ActiveWorkbook.SlicerCaches("Slicer_CubeName").VisibleSlicerItemsList(1) CubeName = Replace(Split(CubeNameRaw, "[")(3), "]", "") If CubeName = "All" Or ServerName = "All" Then MsgBox "Please Select One Cube and Server Name", vbOKOnly, "Slicer Info" Else ConnectionString = GetConnectionString(ServerName, CubeName) UpdateAllQueryTableConnections ConnectionString, CubeName End If End Sub Function GetConnectionString(ServerName As String, CubeName As String) Dim result As String result = "OLEDB;Provider=MSOLAP.5;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog="& CubeName & ";Data Source="& ServerName & ";MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error;Update Isolation Level=2"'"OLEDB;Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog="& CubeName & ";Data Source="& ServerName & ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False" GetConnectionString = result End Function Function GetConnectionString(ServerName As String, CubeName As String) Dim result As String result = "OLEDB;Provider=MSOLAP.5;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog="& CubeName & ";Data Source="& ServerName & ";MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error;Update Isolation Level=2" GetConnectionString = resultEnd FunctionSub UpdateAllQueryTableConnections(ConnectionString As String, CubeName As String) Dim cn As WorkbookConnection Dim oledbCn As OLEDBConnection Dim Count As Integer, i As Integer Dim DBName As String DBName = "Initial Catalog="+ CubeName Count = 0 For Each cn In ThisWorkbook.Connections If cn.Name = "ThisWorkbookDataModel" Then Exit For End If oTmp = Split(cn.OLEDBConnection.Connection, ";") For i = 0 To UBound(oTmp) - 1 If InStr(1, oTmp(i), DBName, vbTextCompare) = 1 Then Set oledbCn = cn.OLEDBConnection oledbCn.SavePassword = True oledbCn.Connection = ConnectionString oledbCn.Refresh Count = Count + 1 End If Next Next If Count = 0 Then MsgBox "Nothing to update", vbOKOnly, "Update Connection" ElseIf Count > 0 Then MsgBox "Update & Refresh Connection Successfully", vbOKOnly, "Update Connection" End IfEnd Sub