Customer-Data Tally work sheet Update Using VBA

[laxmananm]

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]

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

[laxmananm]

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]

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]

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]

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]

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]

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


Const NUM_SHEETS As Long = 8

accordingly.

[laxmananm]

Dear xld,

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

[laxmananm]

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]

You said it was working fine, so what happened?

[laxmananm]

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]

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]

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

[laxmananm]

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]

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]

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]

Again thanks xld for your expensive time.