Excel 2010 Macro stops, loops and crashes, help!

schnizzle

New Member
Joined
Apr 23, 2014
Messages
5
Good Morning!

I was wondering if someone could help. I have built a macro that takes two reports and runs through to create a few pivot tables. When I run it on one machine, Windows 7, Excel 2010, it runs without any problems. When I run it on Windows 8, Excel 2010 it stops at the same point each time. I thought it might be a macro security setting in Excel 2010 but that didnt help. I can post the macro if someone thinks that will help. Not sure what the cause could be. I did create the macro on the Windows 7 machine. Would that make a difference?

Any help would be great. Thank you!

Sincerely,

john
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

BrianMH

Well-known Member
Joined
Mar 26, 2008
Messages
1,490
Yes post the code and let us know what line it fails on.
 

schnizzle

New Member
Joined
Apr 23, 2014
Messages
5
Yes post the code and let us know what line it fails on.
Sub Full_FormatMinus()
'
' Clean up ETime Data
'
ActiveSheet.Name = "eTime Raw Data"
Columns("A:V").Select
Selection.UnMerge
range("F11").Select
Columns("E:E").EntireColumn.AutoFit
Columns("G:G").Select
Columns("I:I").EntireColumn.AutoFit
range("J2").Select
Columns("H:H").ColumnWidth = 9
Columns("K:K").EntireColumn.AutoFit
Columns("M:M").ColumnWidth = 8.57
range("M4").Select
Columns("A:A").ColumnWidth = 12.71
range("A3").Select
Columns("A:A").ColumnWidth = 12.86
Columns("B:B").ColumnWidth = 13.71
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("F:H").Select
Selection.Delete Shift:=xlToLeft
Columns("G:L").Select
Selection.Delete Shift:=xlToLeft
Rows("1:13").Select
Selection.Delete Shift:=xlUp
range("B6").Select
Rows("1:1").RowHeight = 15.75
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("F:K").Select
Selection.EntireColumn.Hidden = False
range("K2").Select
Columns("J:J").ColumnWidth = 5.14
Columns("G:G").ColumnWidth = 7.29
Columns("G:G").Select
Columns("H:H").ColumnWidth = 7
range("H3").Select
Columns("I:I").ColumnWidth = 5
Columns("B:B").Select
Selection.Copy
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
range("B3").Select

Columns("D:D").Select
Selection.Copy
Columns("G:H").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
range("g1").Select
ActiveCell.FormulaR1C1 = "Cost Center Number"
range("h1").Select
ActiveCell.FormulaR1C1 = "Cost Center Description"
range("g2").Select
Application.Goto Reference:="R2C7"
ActiveCell.FormulaR1C1 = "=MID(RC[-3],1,6)"
range("g2").Select
Selection.AutoFill Destination:=range("g2:g" & range("B" & Rows.Count).End(xlUp).Row)
range("g2").Select
ActiveSheet.Calculate

Application.Goto Reference:="R1C7"
Columns("g:g").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.Goto Reference:="R2C8"
range("h2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],CostCenter,2)"
range("h2").Select
Selection.AutoFill Destination:=range("h2:h" & range("B" & Rows.Count).End(xlUp).Row)

Columns("h:h").ColumnWidth = 22.86
range("h1").Select
ActiveSheet.Calculate
Columns("h:h").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False


Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
range("E1").Select
ActiveCell.FormulaR1C1 = "Job Codes"
range("F1").Select
ActiveCell.FormulaR1C1 = "Work Codes"
range("E2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(""J"",MID(RC[-1],8,2))"
range("F2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(""W"",MID(RC[-2],11,2))"
range("E2:F2").Select
Selection.AutoFill Destination:=range("E2:F" & range("B" & Rows.Count).End(xlUp).Row)
range("E2:F1").Select
range("F3").Select
ActiveSheet.Calculate
Columns("E:F").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
range("E9").Select
Application.CutCopyMode = False
Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
range("F1").Select
ActiveCell.FormulaR1C1 = "Job Descriptions"
range("H1").Select
ActiveCell.FormulaR1C1 = "Work Descriptions"
range("F2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],JobCodes,2)"
range("F2").Select
Selection.AutoFill Destination:=range("F2:F" & range("B" & Rows.Count).End(xlUp).Row)
range("F:F").Select
range("H2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],WorkCodes,2)"
range("H2").Select
Selection.AutoFill Destination:=range("H2:H" & range("B" & Rows.Count).End(xlUp).Row)
range("H:H").Select
range("H2").Select
ActiveSheet.Calculate
Columns("F:H").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
range("F13").Select
Application.CutCopyMode = False


range("a1").Select
ActiveCell.FormulaR1C1 = "Date"
range("A2").Select
ActiveCell.FormulaR1C1 = "=TODAY()-1"
range("A2").Select
Selection.AutoFill Destination:=range("A2:A" & range("B" & Rows.Count).End(xlUp).Row)


range("P19").Select
Application.CutCopyMode = False
Selection.Copy
Columns("J:J").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False


Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
range("H1").Select
ActiveCell.FormulaR1C1 = "Work Descriptions Final"
range("H2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[2]=""pto"",""Time Off"",IF(RC[2]=""Holiday"",""Time Off"",IF(RC[2]=""Sick"",""Time Off"",IF(RC[2]=""Bereavement"",""Time Off"",IF(RC[2]=""jury Duty"",""Time Off"",IF(RC[2]=""pto Sal"",""Time Off"",IF(RC[2]=""PTO TERM"",""PTO TERM"",IF(RC[2]=""PTO Buy out"",""PTO Buy out"",RC[1]))))))))"
range("H2").Select
Selection.AutoFill Destination:=range("H2:H" & range("B" & Rows.Count).End(xlUp).Row)
range("H:H").Select
range("H2").Select
ActiveSheet.Calculate
Columns("H:H").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
range("H9").Select
Application.CutCopyMode = False
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
Selection.Replace What:=":45", Replacement:=".75", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=":30", Replacement:=".5", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=":15", Replacement:=".25", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=":00", Replacement:=".0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
range("G2").Select
Application.Goto Reference:="R1C1"
range("A1").Select
ActiveCell.FormulaR1C1 = "Period"
range("A2").Select

range("M1").Select
ActiveCell.FormulaR1C1 = "Location+Name"
range("M2").Select
ActiveCell.FormulaR1C1 = "=TRIM(RC[-1]&""+""&RC[-11])"
range("M2").Select
Selection.AutoFill Destination:=range("M2:M" & range("B" & Rows.Count).End(xlUp).Row)
range("M:M").Select
Columns("M:M").ColumnWidth = 37.56



Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft

Columns("G:G").Select
range("G55").Activate
Selection.Replace What:="5 Colby Lane A", Replacement:="5 Colby Lane", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False

' Clean up Therap Data

Sheets("Therap Data").Select

ActiveSheet.Name = "Therap Raw Data"
Columns("A:P").Select
range("P107").Activate
ActiveSheet.ListObjects.Add(xlSrcRange, range("$A:$P"), , xlYes).Name = _
"Table1_1"
range("G2:G" & range("B" & Rows.Count).End(xlUp).Row).Select
Selection.ListObject.ListColumns.Add Position:=7
Columns("F:F").Select
Selection.Copy
Columns("G:G").Select
ActiveSheet.Paste
range("G1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Name"
Columns("G:G").Select
Selection.Replace What:=" /*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
range("G3").Select
ActiveWindow.SmallScroll ToRight:=3


range("Q1").Select
ActiveCell.FormulaR1C1 = "Location+Name"
range("Q2").Select
ActiveCell.FormulaR1C1 = "=TRIM(RC[-15]&""+""&RC[-10])"
range("Q2").Select
Selection.AutoFill Destination:=range("Q2:Q" & range("B" & Rows.Count).End(xlUp).Row)

range("R1").Select
ActiveCell.FormulaR1C1 = "eTime Punch?"
range("R2").Select
ActiveCell.FormulaR1C1 = _
"=NOT(ISNA(VLOOKUP('Therap Raw Data'!Q2,'eTime Raw Data'!H:H,1,FALSE)))"
range("R2").Select
Selection.AutoFill Destination:=range("R2:R" & range("B" & Rows.Count).End(xlUp).Row)
range("R2:R" & range("B" & Rows.Count).End(xlUp).Row).Select

range("S1").Select
ActiveCell.FormulaR1C1 = "Work Description"
range("S2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX('eTime Raw Data'!C[-9],MATCH(RC[-2],'eTime Raw Data'!C[-5],0),1),""Missing eTime Punch"")"
range("S2").Select
Selection.AutoFill Destination:=range("S2:S" & range("B" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault
range("S2:M" & range("B" & Rows.Count).End(xlUp).Row).Select

Sheets("eTime Raw Data").Select
range("I1").Select
ActiveCell.FormulaR1C1 = "Therap Note"
range("I2").Select
ActiveCell.FormulaR1C1 = _
"=NOT(ISNA(VLOOKUP(RC[-1],Table1_1[[#All],[Location+Name]],1,FALSE)))"
range("I2").Select
Selection.AutoFill Destination:=range("I2:I" & range("B" & Rows.Count).End(xlUp).Row)
range("I2:N" & range("B" & Rows.Count).End(xlUp).Row).Select

'Provides eTime Totals per Staff member by Program


Sheets("eTime Raw Data").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"eTime Raw Data!R1C1:R500C9", Version:=xlPivotTableVersion14). _
CreatePivotTable TableDestination:="", TableName:="PivotTable3" _
, DefaultVersion:=xlPivotTableVersion14

With ActiveSheet.PivotTables("PivotTable3").PivotFields( _
"Work Descriptions Final")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields( _
"Cost Center Description")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Name")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Location+Name")
.Orientation = xlRowField
.Position = 3
End With
ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
"PivotTable3").PivotFields("Hours"), "Count of Hours", xlCount
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Count of Hours")
.Caption = "Sum of Hours"
.Function = xlSum
End With
ActiveSheet.PivotTables("PivotTable3").PivotFields("Work Descriptions Final"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable3").PivotFields( _
"Work Descriptions Final")
.PivotItems("Time Off").Visible = False
End With
ActiveSheet.PivotTables("PivotTable3").PivotFields("Work Descriptions Final"). _
EnableMultiplePageItems = True
With ActiveSheet.PivotTables("PivotTable3").PivotFields( _
"Cost Center Description")

End With
Dim PTitle As PivotField
Set PTitle = ActiveSheet.PivotTables("PivotTable3").PivotFields("Work Descriptions Final")
Application.ScreenUpdating = False

With PTitle
.ClearAllFilters
For i = 1 To .PivotItems.Count
If InStr(1, .PivotItems(i), "Flex - Non Billable", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Non-Billable - Internal Training", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Normal Job", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Non-Billable - Other", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Non-Billable - Time Off", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Pickup or Delivery", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Sort", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "RN Consultant", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Supervisor", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "PTO Buy out", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Time Off", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "#N/A", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "(blank)", vbTextCompare) > 0 _
Then
PTitle.PivotItems(i).Visible = False
End If
Next i
End With


ActiveSheet.Name = "eTime Totals"

'Create Therap Total Staff Time

Sheets("Therap Raw Data").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Table1_1", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="", TableName:="PivotTable4", DefaultVersion _
:=xlPivotTableVersion14
ActiveSheet.Name = "Therap Note Time"
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Billable")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable4").PivotFields("Billable").CurrentPage = _
"(All)"
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Billable")

End With
ActiveSheet.PivotTables("PivotTable4").PivotFields("Billable").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Billable"). _
EnableMultiplePageItems = False
ActiveSheet.PivotTables("PivotTable4").PivotFields("Billable").CurrentPage = _
"Yes"
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Program Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Name")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Location+Name")
.Orientation = xlRowField
.Position = 3
End With
ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("Begin Time"), "Count of Begin Time", xlCount
ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("Begin Time"), "Count of Begin Time2", xlCount
ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("End Time"), "Count of End Time", xlCount
ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("End Time"), "Count of End Time2", xlCount
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Count of Begin Time")
.Caption = "Min of Begin Time"
.Function = xlMin
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Count of Begin Time2")
.Caption = "Max of Begin Time2"
.Function = xlMax
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Count of End Time")
.Caption = "Min of End Time"
.Function = xlMin
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Count of End Time2")
.Caption = "Max of End Time2"
.Function = xlMax
End With
Columns("B:E").Select
Selection.NumberFormat = "[$-409]h:mm AM/PM;@"
Sheets("Therap Raw Data").Select
ActiveWindow.LargeScroll ToRight:=1
range("W2").Select
Selection.Copy
ActiveWindow.SmallScroll ToRight:=-9
Columns("J:K").Select
range("J2").Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "[$-409]h:mm AM/PM;@"
Sheets("Therap Note Time").Select
range("B10").Select
ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh

range("F4").Select
ActiveCell.FormulaR1C1 = _
"=(IF(OR(RC[-4]=RC[-3],RC[-1]=RC[-2],RC[-2]=RC[-3]),RC[-1]-RC[-4],IF(AND(RC[-4]<RC[-3],RC[-4]<RC[-2],RC[-4]<>0),RC[-1]-RC[-4],IF(RC[-2]>RC[-3],((RC[-1]-RC[-2])+(RC[-3]-RC[-4])),IF(RC[-3]>RC[-2],((RC[-2]-RC[-4])+RC[-1]-RC[-3]),""New Formula Needed""))))*24)+0"
range("F4").Select
Selection.AutoFill Destination:=range("F4:F" & range("B" & Rows.Count).End(xlUp).Row)
range("F4:F314").Select
ActiveWindow.SmallScroll Down:=306

range("G4").Select
ActiveCell.FormulaR1C1 = _
"=(IF((RC[-5]=RC[-4]),(RC[-2]-RC[-5]),IF(RC[-3]=RC[-2],(RC[-2]-RC[-5]),((RC[-2]-RC[-4])+(RC[-3]-RC[-5])))))*24"
range("G4").Select
Selection.AutoFill Destination:=range("G4:G" & range("B" & Rows.Count).End(xlUp).Row)
range("G4:G314").Select

'Show Staff Therap Start and End Times Daily

Sheets("Therap Raw Data").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Table1_1", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="", TableName:="PivotTable5", DefaultVersion _
:=xlPivotTableVersion14
ActiveSheet.Name = "Staff Therap Note Times"
With ActiveSheet.PivotTables("PivotTable5").PivotFields("Billable")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable5").PivotFields("Billable").CurrentPage = _
"(All)"
With ActiveSheet.PivotTables("PivotTable5").PivotFields("Billable")

End With
ActiveSheet.PivotTables("PivotTable5").PivotFields("Billable"). _
EnableMultiplePageItems = True
With ActiveSheet.PivotTables("PivotTable5").PivotFields("Program Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable5").PivotFields("Name")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable5").PivotFields("Location+Name")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable5").PivotFields("Begin Time")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables("PivotTable5").PivotFields("End Time")
.Orientation = xlRowField
.Position = 5
End With
ActiveSheet.PivotTables("PivotTable5").PivotFields("Location+Name"). _
Orientation = xlHidden
range("A4").Select
With ActiveSheet.PivotTables("PivotTable5")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
Columns("C:C").EntireColumn.AutoFit
range("C6").Select
ActiveSheet.PivotTables("PivotTable5").PivotFields("Begin Time").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
Columns("B:B").EntireColumn.AutoFit
range("B6").Select
ActiveSheet.PivotTables("PivotTable5").PivotFields("Name").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
Columns("E:J").Select
Selection.EntireColumn.Hidden = True

'Adds The Consumers Total time and Program Total Daily Time

Sheets("Therap Raw Data").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Table1_1", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="", TableName:="PivotTable5", DefaultVersion _
:=xlPivotTableVersion14
ActiveSheet.Name = "Consumer Daily Totals"

With ActiveSheet.PivotTables("PivotTable5").PivotFields("Individual")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("Duration (minutes)"), "Count of Duration (minutes)" _
, xlCount
Sheets("Therap Raw Data").Select
ActiveWindow.LargeScroll ToRight:=1
range("V2").Select
Selection.Copy
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("M:M").Select
range("M2").Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Sheets("Consumer Daily Totals").Select
range("B4").Select
With ActiveSheet.PivotTables("PivotTable5").PivotFields( _
"Count of Duration (minutes)")
.Caption = "Sum of Duration (minutes)"
.Function = xlSum
End With
range("C2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC/60"
range("C2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]/60"
range("C2").Select
Selection.AutoFill Destination:=range("C2:C120")
range("C2:C" & range("B" & Rows.Count).End(xlUp).Row).Select
Columns("C:C").Select
Selection.NumberFormat = "0.0"
ActiveSheet.PivotTables("PivotTable5").PivotSelect "Individual[All]", _
xlLabelOnly + xlFirstRow, True
With ActiveSheet.PivotTables("PivotTable5").PivotFields("Program Name")
.Orientation = xlRowField
.Position = 1
End With

'Create merged data list from eTime and Therap

Worksheets.Add(After:=Worksheets(1)).Name = "E-T Merge"
Sheets("eTime Raw Data").Select
range("H1").Select
range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("E-T Merge").Select
range("A1").PasteSpecial Paste:=xlPasteValues
Sheets("Therap Raw Data").Select
range("Q2").Select
range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("E-T Merge").Select
lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
range("A" & lMaxRows + 1).PasteSpecial xlPasteValues

'Creates E-T Merged Data for Variance Report

range("B1").Select
ActiveCell.FormulaR1C1 = "etime total"
range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX('eTime Totals'!C,MATCH(RC[-1],'eTime Totals'!C[-1],0),1),""Missing eTime Punch"")"
range("B2").Select
Selection.AutoFill Destination:=range("B2:B" & range("A" & Rows.Count).End(xlUp).Row)
range("B2:B" & range("A" & Rows.Count).End(xlUp).Row).Select

range("C1").Select
ActiveCell.FormulaR1C1 = "Therap Time"
range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX('Therap Note Time'!C[3],MATCH(RC[-2],'Therap Note Time'!C[-2],0),1),""Missing Therap Note"")"
range("C2").Select
Selection.AutoFill Destination:=range("C2:C" & range("A" & Rows.Count).End(xlUp).Row)
range("C2:C" & range("A" & Rows.Count).End(xlUp).Row).Select
range("C2:C" & range("A" & Rows.Count).End(xlUp).Row).Select

range("D1").Select
ActiveCell.FormulaR1C1 = "Name"
range("D2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX('eTime Raw Data'!C[-2],MATCH(RC[-3],'eTime Raw Data'!C[4],0),1),(INDEX('Therap Raw Data'!C[3],MATCH(RC[-3],'Therap Raw Data'!C[13],0),1)))"
range("D2").Select
Selection.AutoFill Destination:=range("D2:D" & range("A" & Rows.Count).End(xlUp).Row)
range("D2:D" & range("A" & Rows.Count).End(xlUp).Row).Select
range("D3").Select

range("E1").Select
ActiveCell.FormulaR1C1 = "Program"
range("E2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX('eTime Raw Data'!C7,MATCH(RC[-4],'eTime Raw Data'!C[3],0),1),(INDEX('Therap Raw Data'!C[-2],MATCH(RC[-4],'Therap Raw Data'!C[12],0),1)))"
range("E2").Select
Selection.AutoFill Destination:=range("E2:E" & range("A" & Rows.Count).End(xlUp).Row)
range("E2:E" & range("A" & Rows.Count).End(xlUp).Row).Select

range("F1").Select
ActiveCell.FormulaR1C1 = "Work Descript"
range("F2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX('eTime Raw Data'!C[-2],MATCH(RC[-5],'eTime Raw Data'!C[2],0),1),""Missing eTime Punch"")"
range("F2").Select
Selection.AutoFill Destination:=range("F2:F" & range("A" & Rows.Count).End(xlUp).Row)
range("F2:F" & range("A" & Rows.Count).End(xlUp).Row).Select


'Creates Variance Report

Sheets("E-T Merge").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"E-T Merge!R1C1:R1200C6", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="", TableName:="PivotTable8", _
DefaultVersion:=xlPivotTableVersion14

With ActiveSheet.PivotTables("PivotTable8").PivotFields("Program")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable8").PivotFields("Name")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable8").AddDataField ActiveSheet.PivotTables( _
"PivotTable8").PivotFields("etime total"), "Count of etime total", xlCount
ActiveSheet.PivotTables("PivotTable8").AddDataField ActiveSheet.PivotTables( _
"PivotTable8").PivotFields("Therap Time"), "Sum of Therap Time", xlSum
With ActiveSheet.PivotTables("PivotTable8").PivotFields("Count of etime total")
.Caption = "Max of etime total"
.Function = xlMax
End With
With ActiveSheet.PivotTables("PivotTable8").PivotFields("Sum of Therap Time")
.Caption = "Max of Therap Time"
.Function = xlMax
End With
Columns("B:C").Select
Selection.NumberFormat = "0.0"
range("D2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
Selection.AutoFill Destination:=range("D2:D" & range("A" & Rows.Count).End(xlUp).Row)

range("D2:D" & range("A" & Rows.Count).End(xlUp).Row).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=0.5"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=-0.5"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
range("D1").Select
ActiveCell.FormulaR1C1 = "Variance"
range("E1").Select
Columns("E:E").ColumnWidth = 56.56
range("E1").Select
ActiveCell.FormulaR1C1 = "Note:"
range("E1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Dim PTitle2 As PivotField
Set PTitle2 = ActiveSheet.PivotTables("PivotTable8").PivotFields("Program")
Application.ScreenUpdating = False

With PTitle2
.ClearAllFilters
For i = 1 To .PivotItems.Count
If InStr(1, .PivotItems(i), "Administration", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Adult Case Mgmt", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "CDC Rise 1", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "CDC Rise 2", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "CDC Rise 3", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "CDC Rise 4", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Child Case Mgmt", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Child Development Ctr", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Clinical Svcs", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Compliance Svcs", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Day Pgrm Admin", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "#N/A", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "(blank)", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Experiential Ctr", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Infant Toddler", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Life Works Comm Svcs", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Life Works Emp Svcs", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Maintenance", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Residential Pgrm Admin", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Secure RMS", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Summer Camp", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Training", vbTextCompare) > 0 _
Or InStr(1, .PivotItems(i), "Wormwood Banquet Ctr", vbTextCompare) > 0 _
Then
PTitle2.PivotItems(i).Visible = False
End If
Next i
End With

range("D1:E1").Select
Selection.Font.Bold = True
ActiveSheet.Name = "Variances"

'Deletes any empty Worksheets created by pivot tables

Dim ws As Worksheet
For Each ws In Worksheets
If WorksheetFunction.CountA(ws.Cells) = 0 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
End Sub
 

schnizzle

New Member
Joined
Apr 23, 2014
Messages
5
I highlighted the spot in Red in the macro. Most of the time that is where it stops but at times it will go through the next 3-4 lines to where it selects the next range and then stops. Sorry for the long macro :). I have to take two raw files and create a key between the two then create reports to make one report. It is messy but the best I could do so far. Again, it does work on the machine I created on but no other machine. I tried it on another WIndows 7 Excel 2010. So I am thinking it is a security setting in excel, macro setting or within Windows 7. I am a novice at macros though so I could be completely off too...
 

schnizzle

New Member
Joined
Apr 23, 2014
Messages
5
A quick note too: I did go into Trusted Center and made sure all the settings match. I also went into the Visual Basic Editor and made sure that the references matched as well as made sure both had the same add-ins just in case they impacted any settings.
 

BrianMH

Well-known Member
Joined
Mar 26, 2008
Messages
1,490
When posting code please use code tags.

If it isn't stopping the code at the same place each time I'd say that the problem is with the other computer not the macro.
 

Watch MrExcel Video

Forum statistics

Threads
1,095,226
Messages
5,443,204
Members
405,219
Latest member
CraneS

This Week's Hot Topics

  • Copy entire row if CountA <>0 to another sheet
    [B]I want to copy entire row if CountA <>0 for column J7:AM7 (headers on J6:AM6) and so on till the last used cell is column D and paste the...
  • Select last used Row in Table
    I have created a Table in a Worksheet which is locked to prevent user errors and protect formula. Some of the cells require freetext entries which...
  • excel workbook: do not allow certain file name
    Hello all, Don't think this has ever been asked before, but how do I restrict file save [Before_Save Event] if the name of the file being saved...
  • fixing problem autofilter
    hello i need help about my code when i search by code in textbox it doesn't show anything this is my data [ATTACH type="full"...
  • “Weight”
    Hi, i’ve got a long sheet filled with weights such as kg,g,L & ml. i can build a formula to convert kg into g and liter into ml. How ever, my...
  • How to capitalize everything before a certain character?
    In column A, I have some text: Hello good day.mp3 Hello good day.flac etc. I'd like to capitalize everything before the period. I don't need the...
Top