Results 1 to 7 of 7

Thread: How to get VBA to macro the current table rather than the old table it was built on

  1. #1
    Conjurer Ed Kelly's Avatar
    Join Date
    Jul 2016
    Posts
    164
    Articles
    0
    Excel Version
    2016

    Question How to get VBA to macro the current table rather than the old table it was built on



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Have a pivot Table (Sales Data). Want to be able to drill down on any number in the pivot table (giving me a new sheet and table number) and be able to run a macro on the drilled down Data to make it visually more appealing. So far so good. When I drill down on another number in the pivot table giving me a new sheet and table# and then run the macro on it the macro looks for the origional table number on which I first wrote the macro.

    Is there a line of code that I can use to tell VBA to look at the current table and apply the macro rather than try to always try and find the original table that I first wrote the macro with. Hope that is clear. Have attached excel workbook together with some screen captures


    Macro is Cntl + d

    Thanks for any and all help

    Ed
    Attached Files Attached Files

  2. #2
    Give this a try.
    Code:
    Sub DrillDown()
    '
    ' DrillDown Macro
    '
    ' Keyboard Shortcut: Ctrl+d
    '
        Dim Tbl As Object
        Dim sh As Worksheet
        
        Set sh = ActiveSheet
        
        With sh.Range("A1").CurrentRegion
            .Columns("A:H").EntireColumn.AutoFit
            .Columns("A:A").NumberFormat = "m/d/yyyy"
        End With
        Set Tbl = ActiveSheet.ListObjects(1)
        Tbl.Sort.SortFields.Clear
        Tbl.Sort.SortFields.Add _
                Key:=Range("Table4[[#All],[Date Sold]]"), SortOn:=xlSortOnValues, Order:= _
                xlDescending, DataOption:=xlSortNormal
        With Tbl.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        With sh.Columns("H:H")
            .FormatConditions.AddDatabar
            .FormatConditions(.FormatConditions.Count).ShowValue = True
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1)
                .MinPoint.Modify newtype:=xlConditionValueAutomaticMin
                .MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
            End With
            With .FormatConditions(1).BarColor
                .Color = 5920255
                .TintAndShade = 0
            End With
            .FormatConditions(1).BarFillType = xlDataBarFillGradient
            .FormatConditions(1).Direction = xlContext
            .FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
            .FormatConditions(1).BarBorder.Type = xlDataBarBorderSolid
            .FormatConditions(1).NegativeBarFormat.BorderColorType = _
            xlDataBarColor
            With .FormatConditions(1).BarBorder.Color
                .Color = 5920255
                .TintAndShade = 0
            End With
            .FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
            With .FormatConditions(1).AxisColor
                .Color = 0
                .TintAndShade = 0
            End With
            With .FormatConditions(1).NegativeBarFormat.Color
                .Color = 255
                .TintAndShade = 0
            End With
            With .FormatConditions(1).NegativeBarFormat.BorderColor
                .Color = 255
                .TintAndShade = 0
            End With
        End With
        'Range("Table4[[#Totals],[Customer]]").Select
        Tbl.ListColumns("Customer").TotalsCalculation = _
        xlTotalsCalculationCount
        'Range("Table4[[#Headers],[Date Sold]]").Select
    End Sub

  3. #3
    Conjurer Ed Kelly's Avatar
    Join Date
    Jul 2016
    Posts
    164
    Articles
    0
    Excel Version
    2016
    Malcolm thanks for getting back with a possible solution, not quite there yet, here is what it does

    It takes this information drilled down from the pivot table https://www.screencast.com/t/ZesalBjYsy

    And appears to replicate the header rows https://www.screencast.com/t/QEyg6JfDdNy

    It might be just a minor tweak however don't know enough about VBA to be able to see problems when it does not work.

    Thanks again for the response

    Ed

  4. #4
    I'm not seeing that issue.
    Attached Files Attached Files

  5. #5
    Conjurer Ed Kelly's Avatar
    Join Date
    Jul 2016
    Posts
    164
    Articles
    0
    Excel Version
    2016
    Malcolm,

    Just back at my desk, believe that totally hit the mark, Thanks ever so much saved me bloody days if not weeks...

    So that I can use the code if I were to replicate it and visually present the drilled down data differently is it the highlighted orange or yellow bit of code that I include or is it something else? https://www.screencast.com/t/mqdI8NRuEGZb

    Thanks again

    Ed

  6. #6
    Conjurer Ed Kelly's Avatar
    Join Date
    Jul 2016
    Posts
    164
    Articles
    0
    Excel Version
    2016
    Not sure what I was doing with your original code, think it was a rush of blood to me head!

  7. #7
    Your code was all there. I only revised it to
    1) remove the use of Select
    2) Use "With" instead of repeated ActiveSheet uses
    3) "Set Tbl = ActiveSheet.ListObjects(1)" to replace the specific table references.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •