PDA

View Full Version : 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
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.