Macro causes Excel to exit / attempt auto recover - however works fist time after re-opening?

P

PureBluff

Board Regular
Joined
Apr 4, 2014
Messages
174
Office Version
  1. 2016
Platform
  1. Windows
  2. 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

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
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
Have you stepped through the code manually to see where it crashes ???
Also, you have a lot of Select.Selection lines.....most of these can be removed.
for example
Code: 
Columns("AH:AH").Select


    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False


CAN BE

Columns("AH:AH").Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

AND THIS

Range("C5").Select
    ActiveSheet.Range("C5").Formula = "=INDEX('Raw Data'!AF:AF,MATCH(PRUK!B5,'Raw Data'!C:C,0))"


CAN BE
Range("C5").Formula = "=INDEX('Raw Data'!AF:AF,MATCH(PRUK!B5,'Raw Data'!C:C,0))"

You could also turn calculation to manual until the code has inserted all the formulas and then reinstate automatic calculation
 
Upvote 0
Hi Michael,

As you'll see I do avoid .select in a lot of instances but as I'm self taught, I never knew of an alternative way to do it for selection.autofill, so stuck with .select & the same applies to your examples. I only select when I've used the macro recorder to give me the code required.

I haven't stepped into it to see, no, I wrote the macro and done Alpha testing, however the end user uses it now & reported it to me this week - as I've been away for 3 weeks I'm playing catch-up on everything else, this had to take a back seat. I can run it tomorrow hopefully & see - I threw a thread up hoping for an insight if there was glaringly obvious that a novice wouldn't spot in the interim.
 
Upvote 0
OK, so you understand that you can step through manually by using F8 to see each line ??
If you do this and see which line, if any causes the error ( it will be highlighted in yellow)
I don't have Excel at the moment, otherwise I'd give it a clean myself.
If no one jumps into assist, I'll have another look at it this arvo !!
 
Upvote 0
Cleaned up a bit, but UNTESTED

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 = Cells(Rows.Count, "C").End(xlUp).Row


Range("Af2").Formula = "=a2"


Range("AE3:AE" & lastrow).Formula = "=z3-trunc(z3)"
    ActiveSheet.UsedRange.Replace What:="@", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        ActiveSheet.UsedRange.Replace What:="00000", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Columns("AE:AE").NumberFormat = "hh:mm:ss;@"
    Range("AF3:AF" & lastrow).Formula = "=IF(AE3>0,AF2,A3)"
    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, obj As Object, 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
    Range("Ai3:Ai" & lastrow).Formula = "=trunc(ab3)"
    Columns("Ai:Ai").NumberFormat = "dd/mm/yy;@"
    Range("Aj3:Aj" & lastrow).Formula = "=ab3-trunc(ab3)"
    Columns("Aj:Aj").NumberFormat = "hh:mm;@"
      
    Sheets("PRUK").Activate
     Range("B:B").NumberFormat = General
    Range("B5:B" & rowforpruk).Formula = "='Raw Data'!AH3"
    Range("A5:A" & rowforpruk).Formula = "=INDEX('Raw Data'!AE:AE,MATCH(PRUK!B5,'Raw Data'!C:C,0))"
    Range("C5:C" & rowforpruk).Formula = "=INDEX('Raw Data'!AF:AF,MATCH(PRUK!B5,'Raw Data'!C:C,0))"
    Range("D5:D" & rowforpruk).Formula = "=INDEX('Raw Data'!G:G,MATCH(PRUK!B5,'Raw Data'!C:C,0))"
    Range("G5:G" & rowforpruk).Formula = "=INDEX('Raw Data'!X:X,MATCH(PRUK!B5,'Raw Data'!C:C,0))"
    Range("H5:H" & rowforpruk).Formula = "=IF(INDEX('Raw Data'!E:E,MATCH(PRUK!B5,'Raw Data'!C:C,0))=""HU"",""N"",""Y"")"
    Range("M5:M" & rowforpruk).Formula = "=IF(A5>0,SUMIF('Raw Data'!C:C,PRUK!B5,'Raw Data'!R:R),"""")"
    Range("N5:N" & rowforpruk).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("P5:P" & rowforpruk).Formula = "=if(a5>0,countif('Raw Data'!C:C,B5),"""")"
    ActiveSheet.Range("O2").Formula = "=SUMIF(U:U,"""",N:N)"
    ActiveSheet.Range("Q2").Formula = "=SUMIF(T:T,"""",M:M)"
    ActiveSheet.Range("A5:A" & rowforpruk).NumberFormat = "hh:mm;@"
    Range("Q5:Q" & rowforpruk).Formula = "=IF(A5>0,INDEX('Raw Data'!AI:AI,MATCH(PRUK!B5,'Raw Data'!C:C,0)),"""")"
    ActiveSheet.Range("Q5:Q" & rowforpruk).NumberFormat = "dd/mm/yy;@"
    Range("R5:R" & rowforpruk).Formula = "=IF(A5>0,INDEX('Raw Data'!AJ:AJ,MATCH(PRUK!B5,'Raw Data'!C:C,0)),"""")"
    Range("R5:R" & rowforpruk).NumberFormat = "hh:mm;@"
    Range("AR5:AR" & rowforpruk).Formula = "=IF(A5>0,INDEX('Raw Data'!H:H,MATCH(PRUK!B5,'Raw Data'!C:C,0)),"""")"
    Range("V5:V" & rowforpruk).Formula = "=IF(A5>0,INDEX(Sheet1!F:F,MATCH(PRUK!AR5,Sheet1!A:A,0)),"""")"
    Range("J5:J" & rowforpruk).Formula = "=SUM(ROUNDUP(N5/100,0)+M5)"
    Range("K5:K" & rowforpruk).Formula = "=IF(A5>0,SUMIF('Raw Data'!C:C,PRUK!B5,'Raw Data'!N:N),"""")"
    Range("D:D,G:G").EntireColumn.AutoFit
Dim Rng As Range, 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
With Rows("5:600")
    .Values = .Values
End With
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
        .AutoFilterMode = False
End With
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
       .AutoFilterMode = False
End With
End With


'Sheets("Raw Data").Cells.Clear


Range("b1").Value = "Total Cases"
Range("c1").Value = "Loads"
Range("d1").Value = "Est Total Pallets"
Range("e1").Value = "Total Orders"
Range("f1").Value = "Bonded Orders (6am)"
Range("g1").Value = "Non-Bonded Orders"
Range("i1").Value = "Est Case Pick"
Range("k1").Value = "Est Pallet Pick"
Range("m1").Value = "Bonded Cases (6am)"
Range("o1").Value = "Cases Left to Pick"
Range("q1").Value = "Pallets to Release"
Range("r1").Value = "Orders Left To Check"
Range("s1").Value = "Case Pick Left To Check"
Range("t1").Value = "FP to Check"
Range("v1").Value = "Actual Pallets"
Range("ah1").Value = "Hit Rate"

Range("b2").Formula = "=SUM(K4:K500)"
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))"
Range("d2").Formula = "=SUM(J4:J500)"
Range("e2").Formula = "=COUNTA(B4:B500)"
Range("f2").Formula = "=SUMPRODUCT(--(PRUK!$A$4:$A$500<0.25),--(PRUK!$H$4:$H$500=""Y""))"
Range("g2").Formula = "=COUNTIF(H4:H500,""N"")"
Range("i2").Formula = "=SUM(N4:N500)"
Range("k2").Formula = "=SUM(M4:M500)"
Range("m2").Formula = "=SUMPRODUCT(--(PRUK!$A$4:$A$500<0.25),--(PRUK!$H$4:$H$500=""Y""),(PRUK!$N$4:$N$500))"
Range("o2").Formula = "=SUMIF(U:U,"""",N:N)"
Range("q2").Formula = "=SUMIF(T:T,"""",M:M)"
Range("r2").Formula = "=E2-SUMPRODUCT(--(PRUK!$B$4:$B$500<>""""),--(PRUK!$AB$4:$AB$500<>""""))"
Range("s2").Formula = "=SUMPRODUCT(--(PRUK!$B$4:$B$500<>""""),--(PRUK!$AB$4:$AB$500="""")*(PRUK!$N$4:$N$500))"
Range("t2").Formula = "=SUMPRODUCT(--(PRUK!$B$4:$B$500<>""""),--(PRUK!$AB$4:$AB$500="""")*(PRUK!$M$4:$M$500))"
Range("v2").Formula = "=SUM(O4:O500)"
Range("ah2").Formula = "=i2/sumif(n4:n500,"">0"",p4:p500)"

End Sub
 
Last edited:
Upvote 0
BTW....I didn't modify any of the code that was commented out !!!
 
Upvote 0
Michael M said:
OK, so you understand that you can step through manually by using F8 to see each line ??
If you do this and see which line, if any causes the error ( it will be highlighted in yellow)
I don't have Excel at the moment, otherwise I'd give it a clean myself.
If no one jumps into assist, I'll have another look at it this arvo !!
Click to expand...

Yes, I'm fully aware of stepping into my code, use it for the locals window as my fat fingers like to typo my filepaths often!

I'll be able to step into & also trial your clean up tomorrow at some point. Thanks for your time so far.
 
Upvote 0
No problem with the unedited 'commented code' - If I remember correctly, that was old code from me writing it on a non-shared workbook but it needing to be ran inside a shared workbook.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
210
Coco1
C
T
  • Question
ActiveSheet. Paste error
Replies
1
Views
41
RoryA
RoryA
L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
979
Joe4
Joe4
R
  • Question
Macro not working after adding two new items
Replies
4
Views
111
myall_blues
myall_blues
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
334
RoryA
RoryA

Forum statistics

Threads
1,215,061
Messages
6,122,921
Members
449,094
Latest member
teemeren

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