VBA/pivot.bas

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean)

    If Intersect(Target, ActiveSheet.range("b11:v100000")) Is Nothing Then
        Exit Sub
    End If
    
    On Error GoTo nopiv
    
    If Target.Cells.PivotTable Is Nothing Then
        Exit Sub
    End If
    

    Cancel = True

    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    Dim ri As PivotItemList
    Dim ci As PivotItemList
    Dim df As Object
    Dim rd As Object
    Dim cd As Object
    Dim dd As Object
    
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim pi As PivotItem
    Dim wapi As New Windows_API
    
    
    
    
    Set ri = Target.Cells.PivotCell.RowItems
    Set ci = Target.Cells.PivotCell.ColumnItems
    Set df = Target.Cells.PivotCell.DataField

    Set rd = Target.Cells.PivotTable.RowFields
    Set cd = Target.Cells.PivotTable.ColumnFields
    

    ReDim handler.sc(ri.Count, 1)
    Set pt = Target.Cells.PivotCell.PivotTable
    
    handler.sql = ""
    handler.jsql = ""

    For i = 1 To ri.Count
        If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
        If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
        handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & ri(i).Name & "'"
        jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & ri(i).Name & """"
        handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
        handler.sc(i - 1, 1) = ri(i).Name
        'the following looks for filtered items, but this is redundant because a single one has been isolated
        'For Each pi In pt.PivotFields(piv_fld_index(rd(i).Name, pt)).PivotItems
        '    If Not pi.Visible Then
        '        sql = sql & vbCrLf & "AND " & rd(i).Name & " <> '" & pi.Name & "'"
        '    End If
        'Next pi
    Next i
    
    'this block loops through items selected in colums, which will be ignored for now
    'For i = 1 To ci.Count
    '    sql = sql & vbCrLf & "AND "
    '    sql = sql & cd(piv_pos(cd, ci(i).Parent.Position)).Name & " = '" & ci(i).Name & "'"
    'Next i
    
    'this loop iterates through every pivot field (even if not in the PT) and determines filtered items
    'For Each pf In Target.Cells.PivotTable.PivotFields
    '    For Each pi In pf.PivotItems
    '        If Not pi.Visible Then
    '            sql = sql & vbCrLf & "AND " & pf.Name & " <> '" & pi.Name & "'"
    '        End If
    '    Next pi
    'Next pf
    
    
    scenario = "{" & handler.jsql & "}"
    'Sheets("test").Cells(1, 14) = handler.jsql
    
    Call handler.load_fpvt
    
    'Call http.pull_months(scenario)
    
    'jsql = "SELECT count(*) FROM rlarp.osm_ppfa_varto_jmv WHERE j @> '{" & jsql & "}'::jsonb"
    'sql = "SELECT count(*) FROM rlarp.osm_ppfa_varto_jmv WHERE " & sql
    
    'MsgBox (sql)
    
    'Call wapi.ClipBoard_SetData(sql)
    
nopiv:

End Sub

Function piv_pos(list As Object, target_pos As Long) As Long

    Dim i As Long
    
    For i = 1 To list.Count
        If list(i).Position = target_pos Then
            piv_pos = i
            Exit Function
        End If
    Next i
    'should not get to this point

End Function

Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer

    Dim i As Integer
    
    For i = 1 To pt.PivotFields.Count
        If pt.PivotFields(i).Name = field_name Then
            piv_fld_index = i
            Exit Function
        End If
    Next i

End Function