PureBluff
Board Regular
- Joined
- Apr 4, 2014
- Messages
- 174
- Office Version
- 2016
- Platform
- Windows
- Mobile
Hi All,
I have this macro in a workbook, however I run it on another workbook which is shared & that we want to keep macro's out of. (If that makes sense) - So we use Alt+F8 with target workbook open, and call this macro which is in another workbook as the target workbook changes filename every day.
However, as per the title, if I run it (with numerous other worksheets open) Excel encounters an error, closes and tries to recover my documents. Upon force closing the recovery or waiting an hour for it to recover, if I re-run this macro on the same workbook, it works flalessly within a minute, every time without fail.
Does anyone know what may cause this, or, how I can debug what's triggering the error?
Thanks in advance
I have this macro in a workbook, however I run it on another workbook which is shared & that we want to keep macro's out of. (If that makes sense) - So we use Alt+F8 with target workbook open, and call this macro which is in another workbook as the target workbook changes filename every day.
However, as per the title, if I run it (with numerous other worksheets open) Excel encounters an error, closes and tries to recover my documents. Upon force closing the recovery or waiting an hour for it to recover, if I re-run this macro on the same workbook, it works flalessly within a minute, every time without fail.
Does anyone know what may cause this, or, how I can debug what's triggering the error?
Thanks in advance
Code:
Sub snioghf()Application.ScreenUpdating = False
If Sheets("Raw Data").Range("A1").Value = "" Then
MsgBox "Raw Data not present, please import and retry"
Exit Sub
End If
Sheets("PRUK").Rows("4:500").ClearContents
Sheets("Raw Data").Activate
lastrow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
ActiveSheet.Range("Af2").Formula = "=a2"
ActiveSheet.Range("Ae3").Formula = "=z3-trunc(z3)"
Range("AE3").Select
Selection.AutoFill Destination:=Range("AE3:AE" & lastrow), Type:=xlFillDefault
Cells.Replace What:="@", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="00000", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns("AE:AE").Select
Selection.NumberFormat = "hh:mm:ss;@"
ActiveSheet.Range("AF3").Formula = "=IF(AE3>0,AF2,A3)"
Range("AF3").Select
Selection.AutoFill Destination:=Range("AF3:AF" & lastrow)
ActiveSheet.Range("AF1").Formula = "CM Ref"
'new Sheets("raw data").Activate
' ActiveSheet.Range("AG2").FormulaArray = "=IF(ISNA(INDEX($af$1:$af$" & lastrow & ", MATCH(0, COUNTIF($AG$1:AG1, $af$1:$af$" & lastrow & "), 0))),"""",INDEX($af$1:$af$" & lastrow & ", MATCH(0, COUNTIF($AG$1:AG1, $af$1:$af$" & lastrow & "), 0)))"
'Range("AG2").Select
'Selection.AutoFill Destination:=Range("AG2:AG" & lastrow), Type:=xlFillDefault
' Range("AF1:AF" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
' Range("AF1:AF" & LastRow), CopyToRange:=Range("AG1"), Unique:=Tru
' ActiveSheet.Range("AH2").FormulaArray = "=IF(ISNA(INDEX($c$1:$c$" & lastrow & ", MATCH(0, COUNTIF($ah$1:ah1, $c$1:$c$" & lastrow & "), 0))),"""",INDEX($c$1:$c$" & lastrow & ", MATCH(0, COUNTIF($ah$1:ah1, $c$1:$c$" & lastrow & "), 0)))"
'Range("ah2").Select'
'Selection.AutoFill Destination:=Range("ah2:ah" & lastrow), Type:=xlFillDefault
'Columns("AH:AH").Select
' Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Columns("AH:AH").Select
' Selection.Copy
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
Sheets("Raw Data").Range("AG1").Select
Dim data As Variant, temp As Variant
Dim obj As Object
Dim i As Long
Set obj = CreateObject("scripting.dictionary")
data = ActiveSheet.Range("A1:A" & lastrow)
For i = 1 To UBound(data)
obj(data(i, 1) & "") = ""
Next
temp = obj.keys
Selection.ClearContents
Selection(1, 1).Resize(obj.Count, 1) = Application.Transpose(temp)
' Range("C1:C" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
' ("C1:C" & LastRow), CopyToRange:=Range("AH1"), Unique:=True
Sheets("Raw Data").Range("AH:AH").Select
Selection.NumberFormat = "@"
Sheets("Raw Data").Range("AH1").Select
Dim dataA As Variant, tempA As Variant
Dim objA As Object
Dim iA As Long
Set objA = CreateObject("scripting.dictionary")
dataA = ActiveSheet.Range("C1:C" & lastrow)
For iA = 1 To UBound(data)
objA(dataA(iA, 1) & "") = ""
Next
tempA = objA.keys
Selection.ClearContents
Selection(1, 1).Resize(objA.Count, 1) = Application.Transpose(tempA)
rowforpruk = ActiveSheet.Cells(Rows.Count, "ah").End(xlUp).Row + 1
ActiveSheet.Range("Ai3").Formula = "=trunc(ab3)"
Range("Ai3").Select
Selection.AutoFill Destination:=Range("Ai3:Ai" & lastrow), Type:=xlFillDefault
Columns("Ai:Ai").Select
Selection.NumberFormat = "dd/mm/yy;@"
ActiveSheet.Range("Aj3").Formula = "=ab3-trunc(ab3)"
Range("Aj3").Select
Selection.AutoFill Destination:=Range("Aj3:Aj" & lastrow), Type:=xlFillDefault
Columns("Aj:Aj").Select
Selection.NumberFormat = "hh:mm;@"
Sheets("PRUK").Activate
ActiveSheet.Range("B:B").NumberFormat = General
ActiveSheet.Range("B5").Formula = "='Raw Data'!AH3"
Range("B5").Select
Selection.AutoFill Destination:=Range("B5:B" & rowforpruk), Type:=xlFillDefault
ActiveSheet.Range("A5").Formula = "=INDEX('Raw Data'!AE:AE,MATCH(PRUK!B5,'Raw Data'!C:C,0))"
Range("A5").Select
Selection.AutoFill Destination:=Range("A5:A" & rowforpruk)
Range("C5").Select
ActiveSheet.Range("C5").Formula = "=INDEX('Raw Data'!AF:AF,MATCH(PRUK!B5,'Raw Data'!C:C,0))"
Range("C5").Select
Selection.AutoFill Destination:=Range("C5:C" & rowforpruk)
ActiveSheet.Range("D5").Formula = "=INDEX('Raw Data'!G:G,MATCH(PRUK!B5,'Raw Data'!C:C,0))"
Range("D5").Select
Selection.AutoFill Destination:=Range("D5:D" & rowforpruk)
ActiveSheet.Range("G5").Formula = "=INDEX('Raw Data'!X:X,MATCH(PRUK!B5,'Raw Data'!C:C,0))"
Range("G5").Select
Selection.AutoFill Destination:=Range("G5:G" & rowforpruk)
ActiveSheet.Range("H5").Formula = "=IF(INDEX('Raw Data'!E:E,MATCH(PRUK!B5,'Raw Data'!C:C,0))=""HU"",""N"",""Y"")"
Range("H5").Select
Selection.AutoFill Destination:=Range("H5:H" & rowforpruk)
ActiveSheet.Range("M5").Formula = "=IF(A5>0,SUMIF('Raw Data'!C:C,PRUK!B5,'Raw Data'!R:R),"""")"
Range("M5").Select
Selection.AutoFill Destination:=Range("M5:M" & rowforpruk), Type:=xlFillDefault
ActiveSheet.Range("N5").Formula = "=IF(A5>0,SUMIF('Raw Data'!C:C,PRUK!B5,'Raw Data'!T:T)-SUMIF('Raw Data'!C:C,PRUK!B5,'Raw Data'!T:T)-SUMIF('Raw Data'!C:C,PRUK!B5,'Raw Data'!T:T),"""")"
Range("N5").Select
Selection.AutoFill Destination:=Range("N5:N" & rowforpruk)
ActiveSheet.Range("P5").Formula = "=if(a5>0,countif('Raw Data'!C:C,B5),"""")"
Range("P5").Select
Selection.AutoFill Destination:=Range("P5:P" & rowforpruk)
ActiveSheet.Range("O2").Formula = "=SUMIF(U:U,"""",N:N)"
ActiveSheet.Range("Q2").Formula = "=SUMIF(T:T,"""",M:M)"
ActiveSheet.Range("A5:A" & rowforpruk).Select
Selection.NumberFormat = "hh:mm;@"
ActiveSheet.Range("Q5").Formula = "=IF(A5>0,INDEX('Raw Data'!AI:AI,MATCH(PRUK!B5,'Raw Data'!C:C,0)),"""")"
Range("Q5").Select
Selection.AutoFill Destination:=Range("Q5:Q" & rowforpruk)
ActiveSheet.Range("Q5:Q" & rowforpruk).Select
Selection.NumberFormat = "dd/mm/yy;@"
ActiveSheet.Range("R5").Formula = "=IF(A5>0,INDEX('Raw Data'!AJ:AJ,MATCH(PRUK!B5,'Raw Data'!C:C,0)),"""")"
Range("R5").Select
Selection.AutoFill Destination:=Range("R5:R" & rowforpruk)
ActiveSheet.Range("R5:R" & rowforpruk).Select
Selection.NumberFormat = "hh:mm;@"
ActiveSheet.Range("AR5").Formula = "=IF(A5>0,INDEX('Raw Data'!H:H,MATCH(PRUK!B5,'Raw Data'!C:C,0)),"""")"
Range("AR5").Select
Selection.AutoFill Destination:=Range("AR5:AR" & rowforpruk)
ActiveSheet.Range("V5").Formula = "=IF(A5>0,INDEX(Sheet1!F:F,MATCH(PRUK!AR5,Sheet1!A:A,0)),"""")"
Range("V5").Select
Selection.AutoFill Destination:=Range("V5:V" & rowforpruk)
ActiveSheet.Range("J5").Formula = "=SUM(ROUNDUP(N5/100,0)+M5)"
Range("J5").Select
Selection.AutoFill Destination:=Range("J5:J" & rowforpruk)
ActiveSheet.Range("K5").Formula = "=IF(A5>0,SUMIF('Raw Data'!C:C,PRUK!B5,'Raw Data'!N:N),"""")"
Range("K5").Select
Selection.AutoFill Destination:=Range("K5:K" & rowforpruk)
ActiveSheet.Range("D:D,G:G").EntireColumn.AutoFit
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Range("C5:C" & rowforpruk)
Application.ScreenUpdating = False
For i = WorkRng.Rows.Count To 2 Step -1
If WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i - 1, 1).Value Then
WorkRng.Cells(i, 1).EntireRow.Insert
End If
Next
Rows("5:600").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With ActiveSheet
.AutoFilterMode = False
With Range("A4", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, "#N/A"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
End With
With ActiveSheet
.AutoFilterMode = False
With Range("G4", Range("G" & Rows.Count).End(xlUp))
.AutoFilter 1, "0"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.ClearContents
End With
.AutoFilterMode = False
End With
'Sheets("Raw Data").Cells.Clear
ActiveSheet.Range("b1").Value = "Total Cases"
ActiveSheet.Range("c1").Value = "Loads"
ActiveSheet.Range("d1").Value = "Est Total Pallets"
ActiveSheet.Range("e1").Value = "Total Orders"
ActiveSheet.Range("f1").Value = "Bonded Orders (6am)"
ActiveSheet.Range("g1").Value = "Non-Bonded Orders"
ActiveSheet.Range("i1").Value = "Est Case Pick"
ActiveSheet.Range("k1").Value = "Est Pallet Pick"
ActiveSheet.Range("m1").Value = "Bonded Cases (6am)"
ActiveSheet.Range("o1").Value = "Cases Left to Pick"
ActiveSheet.Range("q1").Value = "Pallets to Release"
ActiveSheet.Range("r1").Value = "Orders Left To Check"
ActiveSheet.Range("s1").Value = "Case Pick Left To Check"
ActiveSheet.Range("t1").Value = "FP to Check"
ActiveSheet.Range("v1").Value = "Actual Pallets"
ActiveSheet.Range("ah1").Value = "Hit Rate"
ActiveSheet.Range("b2").Formula = "=SUM(K4:K500)"
ActiveSheet.Range("c2").FormulaArray = "=SUM(IF(FREQUENCY(IF(LEN(C4:C500)>0,MATCH(C4:C500,C4:C500,0),""""),IF(LEN(C4:C500)>0,MATCH(C4:C500,C4:C500,0),""""))>0,1))"
ActiveSheet.Range("d2").Formula = "=SUM(J4:J500)"
ActiveSheet.Range("e2").Formula = "=COUNTA(B4:B500)"
ActiveSheet.Range("f2").Formula = "=SUMPRODUCT(--(PRUK!$A$4:$A$500<0.25),--(PRUK!$H$4:$H$500=""Y""))"
ActiveSheet.Range("g2").Formula = "=COUNTIF(H4:H500,""N"")"
ActiveSheet.Range("i2").Formula = "=SUM(N4:N500)"
ActiveSheet.Range("k2").Formula = "=SUM(M4:M500)"
ActiveSheet.Range("m2").Formula = "=SUMPRODUCT(--(PRUK!$A$4:$A$500<0.25),--(PRUK!$H$4:$H$500=""Y""),(PRUK!$N$4:$N$500))"
ActiveSheet.Range("o2").Formula = "=SUMIF(U:U,"""",N:N)"
ActiveSheet.Range("q2").Formula = "=SUMIF(T:T,"""",M:M)"
ActiveSheet.Range("r2").Formula = "=E2-SUMPRODUCT(--(PRUK!$B$4:$B$500<>""""),--(PRUK!$AB$4:$AB$500<>""""))"
ActiveSheet.Range("s2").Formula = "=SUMPRODUCT(--(PRUK!$B$4:$B$500<>""""),--(PRUK!$AB$4:$AB$500="""")*(PRUK!$N$4:$N$500))"
ActiveSheet.Range("t2").Formula = "=SUMPRODUCT(--(PRUK!$B$4:$B$500<>""""),--(PRUK!$AB$4:$AB$500="""")*(PRUK!$M$4:$M$500))"
ActiveSheet.Range("v2").Formula = "=SUM(O4:O500)"
ActiveSheet.Range("ah2").Formula = "=i2/sumif(n4:n500,"">0"",p4:p500)"
End Sub