Customer-Data Tally work sheet Update Using VBA

**laxmananm** · 10-13-2014, 04:14 AM

Hi All,

Am New to this forum and im working on assignment which has details below.

i'm looking for a macro that will move and total some data from 7 worksheets to a tally worksheet in the same workbook.
we have used a pivot table to do this before but we have determined that we would like to be like this.
any and all help would be appreciated.
I have included a sample of the workbook with 2 data sheets and the tally sheet.
for each customer number in col a I need it to copy col b,i,j,o and m.
I then need it to sum the total of col c from the store data sheet and put in col f of the tally worksheet,
sum the total of col d from the store data sheet and put in col g of the tally worksheet and sum the total of col e from the store data sheet
and put into col h of tally worksheet.
I then also need it to take the value from col c of the store data worksheet and put it into the corresponding store column in the tally worksheet (colj-colp).
there is a formula in col I of the tally worksheet for the ret % figure.
But my original workbook having 7 worksheets each named co1,co2,co4,co5,co6,co7,co8(all of will have the same layout of data)
that will be used to combine onto the tally worksheet.

THanks,
lax

**Bob Phillips** · 10-13-2014, 05:54 AM

If an item is on Co2 but not on Co1, should that be included?

**laxmananm** · 10-13-2014, 05:59 AM

Originally Posted by xld

If an item is on Co2 but not on Co1, should that be included?

Dear Xld,

thanks for the help..yes it should be included..

Kind Regards,
laxman

**Bob Phillips** · 10-13-2014, 08:09 AM

Option Explicit

Public Sub TallyData()
Const PIVOT_TALLY As String = "pvtTally"
Dim wsScratch As Worksheet
Dim wsPivot As Worksheet
Dim wsResults As Worksheet
Dim numrows As Long
Dim nextrow As Long
Dim i As Long
    
    Sheets(Array("Co1", "Co2", "Co3", "Co4", "Co5", "Co6", "Co7", "Co8")).Select
    With Selection
        .Range("P1").Value = "Co1"
        .Range("Q1").Value = "Co2"
        .Range("P1:Q1").AutoFill Destination:=.Range("P1:W1"), Type:=xlFillDefault
    End With
    
    Application.ScreenUpdating = False

    Worksheets("Co1").Select
    Set wsScratch = Worksheets.Add
    Worksheets("Co1").Rows(1).Copy wsScratch.Range("A1")
    nextrow = 2
    
    For i = 1 To 8
    
        With Worksheets("Co" & i)
        
            numrows = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
            .Range("C2").Resize(numrows).Copy .Cells(2, 15 + i)
            .Rows(2).Resize(numrows).Copy wsScratch.Cells(nextrow, "A")
            nextrow = nextrow + numrows
        End With
    Next i
    
    Set wsPivot = Worksheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                                      SourceData:=wsScratch.Name & "!R1C1:R" & nextrow - 1 & "C23", _
                                      Version:=xlPivotTableVersion14).CreatePivotTable _
                                            TableDestination:=wsPivot.Name & "!R1C1", _
                                            TableName:="pvtTALLY", _
                                            DefaultVersion:=xlPivotTableVersion14
    ActiveWorkbook.ShowPivotTableFieldList = True
    With wsPivot
    
        With .PivotTables("pvtTally")
        
            With .PivotFields("CUST#")
        
                .Orientation = xlRowField
                .Position = 1
            End With
    
            With .PivotFields("CUST-NAME")
            
                .Orientation = xlRowField
                .Position = 2
            End With
    
            With .PivotFields("ADDRESS")
            
                .Orientation = xlRowField
                .Position = 3
            End With
    
            With .PivotFields("CITY")
            
                .Orientation = xlRowField
                .Position = 4
            End With
    
            With .PivotFields("ZIP")
            
                .Orientation = xlRowField
                .Position = 5
            End With
    
            .AddDataField .PivotFields("12 MOýSALES"), "12 MOýSALES ", xlSum
            .AddDataField .PivotFields("12 MOýGROSS"), "12 MOýGROSS ", xlSum
            .AddDataField .PivotFields("12 MOýCREDITS"), "12 MOýCREDITS ", xlSum
            .AddDataField .PivotFields("Co1"), "Co1 ", xlSum
            .AddDataField .PivotFields("Co2"), "Co2 ", xlSum
            .AddDataField .PivotFields("Co3"), "Co3 ", xlSum
            .AddDataField .PivotFields("Co4"), "Co4 ", xlSum
            .AddDataField .PivotFields("Co5"), "Co5 ", xlSum
            .AddDataField .PivotFields("Co6"), "Co6 ", xlSum
            .AddDataField .PivotFields("Co7"), "Co7 ", xlSum
            .AddDataField .PivotFields("Co8"), "Co8 ", xlSum
            
            .PivotFields("CUST#").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("CUST-NAME").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("12 MOýSALES").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("12 MOýGROSS").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("12 MOýCREDITS").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("12 MOýGP %").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("12 MOýRET %").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("SALE-TYPE").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("ADDRESS").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("CITY").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("ZIP").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("PHONE#").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("SHIP VIA").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("COMPANY").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("HS").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Co1").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Co2").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Co3").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Co4").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Co5").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Co6").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Co7").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            .PivotFields("Co8").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        
            .ColumnGrand = False
            .RowGrand = False
    
            .HasAutoFormat = False
            .InGridDropZones = True
            .ShowDrillIndicators = False
            .RowAxisLayout xlTabularRow
        End With
    End With
    
    Set wsResults = Worksheets.Add
    wsResults.Name = "Tally"
    With wsResults
    
        wsPivot.PivotTables("pvtTALLY").TableRange1.Offset(1, 0).Copy wsResults.Range("A1")
        .Columns("B:E").EntireColumn.AutoFit
        .Columns("F:H").NumberFormat = "#,##0.00"
        .Columns("I:P").NumberFormat = "#,##0"
        .Columns("I:I").Insert Shift:=xlToRight
        .Range("I1").Value = "12 MOýRET %"
        numrows = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
        .Range("I2").Resize(numrows).Formula = "=-H2/(F2+H2)"
        .Columns("I").NumberFormat = "0.00%"
        
        .Range("A2").Select
        ActiveWindow.FreezePanes = True
    End With
    
    For i = 1 To 8
    
        Worksheets("Co" & i).Columns("P:W").Delete
    Next i
    
    Application.DisplayAlerts = False
    wsScratch.Delete
    wsPivot.Delete
    
    Application.ScreenUpdating = True
End Sub

**laxmananm** · 10-14-2014, 12:20 AM

Dear Xld,

Thank you so much for the help man..It is running .But am facing error while executing after some time.attaching snapshot for your reference.Pls help.

Thanks,
lax

**Bob Phillips** · 10-14-2014, 01:29 AM

The error message says that the sheet it is trying to create already exists, presumably Tally. Delete all the sheets I created, Sheet1, Sheet2 etc., and try this mod

Option Explicit
 
Public Sub TallyData()
    Const NUM_SHEETS As Long = 8
    Const RESULTS_NAME As String = "Tally"
    Const PIVOT_TALLY = "pvt" & RESULTS_NAME
    Dim wsScratch As Worksheet
    Dim wsPivot As Worksheet
    Dim wsResults As Worksheet
    Dim aryRowFields As Variant
    Dim aryValueFields As Variant
    Dim arySheetNames As Variant
    Dim numrows As Long
    Dim nextrow As Long
    Dim i As Long
    
    Application.DisplayAlerts = False
     
    On Error Resume Next
    Set wsResults = Worksheets(RESULTS_NAME)
    If Not wsResults Is Nothing Then wsResults.Delete
    
    On Error GoTo errhandler
    
    aryRowFields = Array("CUST#", "CUST-NAME", "ADDRESS", "CITY", "ZIP")
    ReDim aryValueFields(1 To NUM_SHEETS + 3)
    aryValueFields(1) = "12 MOýSALES": aryValueFields(2) = "12 MOýGROSS": aryValueFields(3) = "12 MOýCREDITS"
    ReDim arySheetNames(1 To NUM_SHEETS)
    For i = 1 To NUM_SHEETS
        
        aryValueFields(i + 3) = "Co" & i
        arySheetNames(i) = "Co" & i
    Next i
    
    Sheets(arySheetNames).Select
    With Selection
        .Range("P1").Value = "Co1"
        .Range("Q1").Value = "Co2"
        If NUM_SHEETS > 2 Then .Range("P1:Q1").AutoFill Destination:=.Range("P1").Resize(, NUM_SHEETS), Type:=xlFillDefault
    End With
     
    Application.ScreenUpdating = False
     
    Worksheets("Co1").Select
    Set wsScratch = Worksheets.Add
    Worksheets("Co1").Rows(1).Copy wsScratch.Range("A1")
    nextrow = 2
     
    For i = 1 To NUM_SHEETS
         
        With Worksheets("Co" & i)
             
            numrows = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
            .Range("C2").Resize(numrows).Copy .Cells(2, 15 + i)
            .Rows(2).Resize(numrows).Copy wsScratch.Cells(nextrow, "A")
            nextrow = nextrow + numrows
        End With
    Next i
     
    Set wsPivot = Worksheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
    SourceData:=wsScratch.Name & "!R1C1:R" & nextrow - 1 & "C" & 15 + NUM_SHEETS, _
    Version:=xlPivotTableVersion14).CreatePivotTable _
    TableDestination:=wsPivot.Name & "!R1C1", _
    TableName:=PIVOT_TALLY, _
    DefaultVersion:=xlPivotTableVersion14
    ActiveWorkbook.ShowPivotTableFieldList = True
    With wsPivot
         
        With .PivotTables(PIVOT_TALLY)
        
            For i = LBound(aryRowFields) To UBound(aryRowFields)
            
                With .PivotFields(aryRowFields(i))
                 
                    .Orientation = xlRowField
                    .Position = i - LBound(aryRowFields) + 1
                End With
            Next i
        
            For i = LBound(aryRowFields) To UBound(aryRowFields)
            
                .PivotFields(aryRowFields(i)).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            Next i
             
            For i = LBound(aryValueFields) To UBound(aryValueFields)

                .AddDataField .PivotFields(aryValueFields(i)), aryValueFields(i) & " ", xlSum
            Next i
        
            For i = LBound(aryValueFields) To UBound(aryValueFields)
            
                .PivotFields(aryValueFields(i)).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            Next i
             
            .ColumnGrand = False
            .RowGrand = False
             
            .HasAutoFormat = False
            .InGridDropZones = True
            .ShowDrillIndicators = False
            .RowAxisLayout xlTabularRow
        End With
    End With
     
    Set wsResults = Worksheets.Add
    wsResults.Name = RESULTS_NAME
    With wsResults
         
        wsPivot.PivotTables(PIVOT_TALLY).TableRange1.Offset(1, 0).Copy wsResults.Range("A1")
        .Columns("B:E").EntireColumn.AutoFit
        .Columns("F:H").NumberFormat = "#,##0.00"
        .Columns("I:P").NumberFormat = "#,##0"
        .Columns("I:I").Insert Shift:=xlToRight
        .Range("I1").Value = "12 MOýRET %"
        numrows = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
        .Range("I2").Resize(numrows).Formula = "=-H2/(F2+H2)"
        .Columns("I").NumberFormat = "0.00%"
         
        .Range("A2").Select
        ActiveWindow.FreezePanes = True
    End With
    
errhandler:
    For i = 1 To NUM_SHEETS
         
        Worksheets("Co" & i).Columns("P").Resize(, NUM_SHEETS).Delete
    Next i
    
    On Error Resume Next
    
    If Not wsScratch Is Nothing Then wsScratch.Delete
    If Not wsPivot Is Nothing Then wsPivot.Delete
     
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

**laxmananm** · 10-14-2014, 01:46 AM

Dear xld,

Thanks for the help again.When am trying to Run the code (with the sheets col1,col2)the Tally sheet gets disappearing after the run.Even am Facing error in the line "Worksheets("Co" & i).Columns("P").Resize(, NUM_SHEETS).Delete". If i delete all the sheets (col1,col2) before running it's getting error.So on either way am getting error..pls have a look and help me to resolve this issue..Have attached the sheet with macro code which i applied.

Kind regards,
laxman

**Bob Phillips** · 10-14-2014, 01:54 AM

You said you would have 8 Co sheets. If you have less, modify the line

    Const NUM_SHEETS As Long = 8

accordingly.

**laxmananm** · 10-14-2014, 02:02 AM

Dear xld,

That's working like a charm..how could i say thanks alone..is there any word define thanks other than "Thanks"

**laxmananm** · 10-14-2014, 02:16 AM

dear xld,

everything fine..After Run the code successfully the Sheet "Tally" got Disappeared.Results are need to be stored in the Tally sheet only.Kindly help

Thanks,
lax

**Bob Phillips** · 10-14-2014, 02:20 AM

You said it was working fine, so what happened?

**laxmananm** · 10-14-2014, 02:44 AM

Dear Xld,

From My First post of this thread below points..

"for each customer number in col a I need it to copy col b,i,j,o and m.
I then need it to sum the total of col c from the store data sheet and put in col f of the tally worksheet,
sum the total of col d from the store data sheet and put in col g of the tally worksheet and sum the total of col e from the store data sheet
and put into col h of tally worksheet.
I then also need it to take the value from col c of the store data worksheet and put it into the corresponding store column in the tally worksheet (colj-colp).
there is a formula in col I of the tally worksheet for the ret % figure."

Your code is working with out any error..But comment from above ..the tally sheet is not adjusting and it is getting disappear after the RUN of macro.

Thanks,
lax

**Bob Phillips** · 10-14-2014, 03:36 AM

It seems to be driven by the cell currently selected, my selection of sheets can be dependent upon that.

I have changed the code to not select the sheets, so this should help

Public Sub TallyData()
    Const NUM_SHEETS As Long = 2
    Const RESULTS_NAME As String = "Tally"
    Const PIVOT_TALLY = "pvt" & RESULTS_NAME
    Dim wsScratch As Worksheet
    Dim wsPivot As Worksheet
    Dim wsResults As Worksheet
    Dim aryRowFields As Variant
    Dim aryValueFields As Variant
    Dim arySheetNames As Variant
    Dim numrows As Long
    Dim nextrow As Long
    Dim i As Long
     
    Application.DisplayAlerts = False
     
    On Error Resume Next
    Set wsResults = Worksheets(RESULTS_NAME)
    If Not wsResults Is Nothing Then wsResults.Delete
     
    On Error GoTo errhandler
     
    aryRowFields = Array("CUST#", "CUST-NAME", "ADDRESS", "CITY", "ZIP")
    ReDim aryValueFields(1 To NUM_SHEETS + 3)
    aryValueFields(1) = "12 MOýSALES": aryValueFields(2) = "12 MOýGROSS": aryValueFields(3) = "12 MOýCREDITS"
    ReDim arySheetNames(1 To NUM_SHEETS)
    For i = 1 To NUM_SHEETS
         
        aryValueFields(i + 3) = "Co" & i
        arySheetNames(i) = "Co" & i
    Next i
     
    Application.ScreenUpdating = False
     
    Worksheets("Co1").Select
    Set wsScratch = Worksheets.Add
    With wsScratch
    
        Worksheets("Co1").Range("A1:O1").Copy .Range("A1")
        .Range("P1").Value = "Co1"
        .Range("Q1").Value = "Co2"
        If NUM_SHEETS > 2 Then .Range("P1:Q1").AutoFill Destination:=.Range("P1").Resize(, NUM_SHEETS), Type:=xlFillDefault
    End With
    nextrow = 2
     
    For i = 1 To NUM_SHEETS
         
        With Worksheets("Co" & i)
             
            numrows = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
            .Range("C2").Resize(numrows).Copy .Cells(2, 15 + i)
            .Rows(2).Resize(numrows).Copy wsScratch.Cells(nextrow, "A")
            nextrow = nextrow + numrows
        End With
    Next i
     
    Set wsPivot = Worksheets.Add
    On Error GoTo 0
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
    SourceData:=wsScratch.Name & "!R1C1:R" & nextrow - 1 & "C" & 15 + NUM_SHEETS, _
    Version:=xlPivotTableVersion14).CreatePivotTable _
    TableDestination:=wsPivot.Name & "!R1C1", _
    TableName:=PIVOT_TALLY, _
    DefaultVersion:=xlPivotTableVersion14
    ActiveWorkbook.ShowPivotTableFieldList = True
    With wsPivot
         
        With .PivotTables(PIVOT_TALLY)
             
            For i = LBound(aryRowFields) To UBound(aryRowFields)
                 
                With .PivotFields(aryRowFields(i))
                     
                    .Orientation = xlRowField
                    .Position = i - LBound(aryRowFields) + 1
                End With
            Next i
             
            For i = LBound(aryRowFields) To UBound(aryRowFields)
                 
                .PivotFields(aryRowFields(i)).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            Next i
             
            For i = LBound(aryValueFields) To UBound(aryValueFields)
                 
                .AddDataField .PivotFields(aryValueFields(i)), aryValueFields(i) & " ", xlSum
            Next i
             
            For i = LBound(aryValueFields) To UBound(aryValueFields)
                 
                .PivotFields(aryValueFields(i)).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            Next i
             
            .ColumnGrand = False
            .RowGrand = False
             
            .HasAutoFormat = False
            .InGridDropZones = True
            .ShowDrillIndicators = False
            .RowAxisLayout xlTabularRow
        End With
    End With
     
    Set wsResults = Worksheets.Add
    wsResults.Name = RESULTS_NAME
    With wsResults
         
        wsPivot.PivotTables(PIVOT_TALLY).TableRange1.Offset(1, 0).Copy wsResults.Range("A1")
        .Columns("B:E").EntireColumn.AutoFit
        .Columns("F:H").NumberFormat = "#,##0.00"
        .Columns("I:P").NumberFormat = "#,##0"
        .Columns("I:I").Insert Shift:=xlToRight
        .Range("I1").Value = "12 MOýRET %"
        numrows = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
        .Range("I2").Resize(numrows).Formula = "=-H2/(F2+H2)"
        .Columns("I").NumberFormat = "0.00%"
         
        .Range("A2").Select
        ActiveWindow.FreezePanes = True
    End With
     
errhandler:
    For i = 1 To NUM_SHEETS
         
        Worksheets("Co" & i).Columns("P").Resize(, NUM_SHEETS).Delete
    Next i
     
    On Error Resume Next
     
    If Not wsScratch Is Nothing Then wsScratch.Delete
    If Not wsPivot Is Nothing Then wsPivot.Delete
     
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

**Bob Phillips** · 10-14-2014, 03:37 AM

BTW I am not updating Tally, I wipe it out and recreate t.

**laxmananm** · 10-14-2014, 03:57 AM

Dear Xld,

That is not a pbm man.Anyway the am fine if the result could come correct..You are the boss..Thanks for your expensive time to spent for me.

Thanks,
laxman

**laxmananm** · 10-14-2014, 11:16 AM

Dear xld,

All r fine..but my original workbook I do not have the company 3(co3)..so we could leave it there and it need to carry the route # from column M and put it to column R on the Tally sheet..I m not clear where I need to update the code..kindly help on the last small update.

Thanks
Laxman

**Bob Phillips** · 10-14-2014, 03:11 PM

Quite a few changes

Public Sub TallyData()
    Const NUM_SHEETS As Long = 2
    Const RESULTS_NAME As String = "Tally"
    Const PIVOT_TALLY = "pvt" & RESULTS_NAME
    Dim wsScratch As Worksheet
    Dim wsPivot As Worksheet
    Dim wsResults As Worksheet
    Dim aryRowFields As Variant
    Dim aryValueFields As Variant
    Dim arySheetNames As Variant
    Dim numrows As Long
    Dim nextrow As Long
    Dim i As Long
     
    Application.DisplayAlerts = False
     
    On Error Resume Next
    Set wsResults = Worksheets(RESULTS_NAME)
    If Not wsResults Is Nothing Then wsResults.Delete
     
    On Error GoTo errhandler
     
    aryRowFields = Array("CUST#", "CUST-NAME", "ADDRESS", "CITY", "ZIP", "SHIP VIA")
    ReDim aryValueFields(1 To NUM_SHEETS + 3)
    aryValueFields(1) = "12 MOýSALES": aryValueFields(2) = "12 MOýGROSS": aryValueFields(3) = "12 MOýCREDITS"
    ReDim arySheetNames(1 To NUM_SHEETS)
    For i = 1 To NUM_SHEETS
         
        aryValueFields(i + 3) = "Co" & i
        arySheetNames(i) = "Co" & i
    Next i
     
    Application.ScreenUpdating = False
     
    Worksheets("Co1").Select
    Set wsScratch = Worksheets.Add
    With wsScratch
         
        Worksheets("Co1").Range("A1:O1").Copy .Range("A1")
        .Range("P1").Value = "Co1"
        .Range("Q1").Value = "Co2"
        If NUM_SHEETS > 2 Then .Range("P1:Q1").AutoFill Destination:=.Range("P1").Resize(, NUM_SHEETS), Type:=xlFillDefault
    End With
    nextrow = 2
     
    For i = 1 To NUM_SHEETS
         
        With Worksheets("Co" & i)
             
            numrows = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
            .Range("C2").Resize(numrows).Copy .Cells(2, 15 + i)
            .Rows(2).Resize(numrows).Copy wsScratch.Cells(nextrow, "A")
            nextrow = nextrow + numrows
        End With
    Next i
     
    Set wsPivot = Worksheets.Add
    On Error GoTo 0
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
    SourceData:=wsScratch.Name & "!R1C1:R" & nextrow - 1 & "C" & 15 + NUM_SHEETS, _
    Version:=xlPivotTableVersion14).CreatePivotTable _
    TableDestination:=wsPivot.Name & "!R1C1", _
    TableName:=PIVOT_TALLY, _
    DefaultVersion:=xlPivotTableVersion14
    ActiveWorkbook.ShowPivotTableFieldList = True
    With wsPivot
         
        With .PivotTables(PIVOT_TALLY)
             
            For i = LBound(aryRowFields) To UBound(aryRowFields)
                 
                With .PivotFields(aryRowFields(i))
                     
                    .Orientation = xlRowField
                    .Position = i - LBound(aryRowFields) + 1
                End With
            Next i
             
            For i = LBound(aryRowFields) To UBound(aryRowFields)
                 
                .PivotFields(aryRowFields(i)).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            Next i
             
            For i = LBound(aryValueFields) To UBound(aryValueFields)
                 
                .AddDataField .PivotFields(aryValueFields(i)), aryValueFields(i) & " ", xlSum
            Next i
             
            For i = LBound(aryValueFields) To UBound(aryValueFields)
                 
                .PivotFields(aryValueFields(i)).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            Next i
             
            .ColumnGrand = False
            .RowGrand = False
             
            .HasAutoFormat = False
            .InGridDropZones = True
            .ShowDrillIndicators = False
            .RowAxisLayout xlTabularRow
        End With
    End With
     
    Set wsResults = Worksheets.Add
    wsResults.Name = RESULTS_NAME
    With wsResults
         
        wsPivot.PivotTables(PIVOT_TALLY).TableRange1.Offset(1, 0).Copy wsResults.Range("A1")
        .Columns("B:F").EntireColumn.AutoFit
        .Columns("G:I").NumberFormat = "#,##0.00"
        .Columns("J:Q").NumberFormat = "#,##0"
        .Columns("J").Insert Shift:=xlToRight
        .Range("J1").Value = "12 MOýRET %"
        numrows = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
        .Range("J2").Resize(numrows).Formula = "=-I2/(G2+I2)"
        .Columns("J").NumberFormat = "0.00%"
        .Columns("F").Cut
        .Columns("S").Insert Shift:=xlToRight
         
        .Range("A2").Select
        ActiveWindow.FreezePanes = True
    End With
     
errhandler:
    For i = 1 To NUM_SHEETS
         
        Worksheets("Co" & i).Columns("P").Resize(, NUM_SHEETS).Delete
    Next i
     
    On Error Resume Next
     
    If Not wsScratch Is Nothing Then wsScratch.Delete
    If Not wsPivot Is Nothing Then wsPivot.Delete
     
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

**laxmananm** · 10-15-2014, 01:22 AM

Again thanks xld for your expensive time.

Thread: Customer-Data Tally work sheet Update Using VBA

Thread Tools

Display

Customer-Data Tally work sheet Update Using VBA

Posting Permissions