Excel 2010 Macro stops, loops and crashes, help!

S

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
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
BrianMH said:
Yes post the code and let us know what line it fails on.
Click to expand...

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
 
Upvote 0
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...
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Excel/365 VBA crash issues recently
Replies
0
Views
428
picklefactory
P
F
  • Question Question
Making a UserForm behave as a Tool Window for another process
Replies
3
Views
226
fitzmorrispr
F
S
  • Solved
run macro from network xlam addin via vba
Replies
2
Views
250
solidENM
S
C
  • Question Question
Excel for Mac Crashes when I protect Sheet, and run a macro.
Replies
0
Views
273
CKW USMC
C
J
  • Question Question
Excel Compiled VBA Corruption - Why Does It Happen?
Replies
2
Views
496
Fluff
Fluff

Forum statistics

Threads
1,223,236
Messages
6,170,915
Members
452,366
Latest member
TePunaBloke

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top