vault backup: 2024-02-19 10:59:09

PivotShortcut.bas

@@ -7,10 +7,10 @@ Sub SetPivotShortcutKeys()
     Call Application.MacroOptions("PERSONAL.xlsb!CollapsePvtItem", "", , , , "Z")
     Call Application.MacroOptions("PERSONAL.xlsb!ExpandPvtFld", "", , , , "S")
     Call Application.MacroOptions("PERSONAL.xlsb!ExpandPvtItem", "", , , , "X")
-    Call Application.MacroOptions("PERSONAL.xlsb!PastValues", "", , , , "V")
-    Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format", "", , , , "F")
-    Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_3dec", "", , , , "N")
-    Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_1dec", "", , , , "M")
+    'Call Application.MacroOptions("PERSONAL.xlsb!PastValues", "", , , , "V")
+    'Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format", "", , , , "F")
+    'Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_3dec", "", , , , "N")
+    'Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_1dec", "", , , , "M")
 
 End Sub
 

SalesWalk.cls

@@ -0,0 +1,62 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "SalesWalk"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
+
+Private Sub Worksheet_Change(ByVal Target As Range)
+
+    Dim cust As String
+    Dim bucket As String
+    Dim note As String
+    Dim r As Range
+    Dim req As New WinHttp.WinHttpRequest
+    Dim wr As String
+    
+    'Exit Sub
+
+    If Not Intersect(Target, Me.Range("K:L")) Is Nothing And Target.Columns.Count <= 2 Then
+        For Each r In Target.Rows
+            cust = Sheets("Data").Cells(r.row, 3)
+            bucket = Sheets("Data").Cells(r.row, 11)
+            note = Sheets("Data").Cells(r.row, 12)
+            
+            With req
+                .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+                .Open "GET", "http://usmidsap02:8085/sales_walk/write_note/" & cust & "/" & bucket & "/" & note, True
+                .Send
+                .WaitForResponse
+                wr = .ResponseText
+            End With
+            
+            'Sheets("Data").Cells(r.row, 12) = wr
+        Next r
+    Else
+        If Target.address = "$D$1" Then
+            Me.UpdatePowerQuerySQL
+        End If
+    End If
+End Sub
+
+
+Sub UpdatePowerQuerySQL()
+    Dim qry As WorkbookQuery
+    Dim newSQL As String
+    basecmd = "let Source = Value.NativeQuery(PostgreSQL.Database(""usmidsap02"", ""ubm""), ""SELECT * FROM rlarp.sales_walk WHERE"", null, [EnableFolding=true]) in Source"
+    
+    ' Change "QueryName" to the actual name of your query
+    Set qry = ThisWorkbook.Queries("Query1")
+    
+    ' Replace the SQL query text with the new query
+    newSQL = Replace(basecmd, "WHERE", "WHERE dsm = '" & Sheets("Data").Cells(1, 4).value & "'")
+    
+    qry.Formula = newSQL
+    
+    ' Refresh the query to apply the change
+    qry.Refresh
+End Sub
+