I have a customer complaint tracking sheet. It calculates five different date / workday columns with counts. The dates are all functioning correctly, but it is adding rows between 80,000 and 140,000. At the most, all I would ever need is 500.
I tried recording a macro selecting rows for empty cells for deletion, but it freezes the computer in thought for several minutes, and didn't work.
Option Explicit
Sub FilterOFF()
'
' FilterOFF
'
'
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
Selection.AutoFilter
TurnIn
End Sub
Sub TurnIn()
'start date S (8D start date), count V (Workdays waiting for part), end count date W (Material Arrived Date)
Dim lastrow As Long, f As String
Debug.Print f
f = "=NetworkDays(RC[-3],IF(RC[1]>0,RC[1],Today()),lists!R2C3:R11C3)"
With ThisWorkbook.Sheets("open")
lastrow = .Cells(.Rows.Count, "S").End(xlUp).Row
.Range("V3:V" & lastrow).FormulaR1C1 = f
End With
Garantee
End Sub
Sub Garantee()
'start date T (Garantee Start Date), count date U (Garantee Expires)
Dim ws As Worksheet
Dim lRow As Long, i As Long
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("open")
With ws
lRow = .Range("s" & .Rows.Count).End(xlUp).Row
For i = 3 To lRow
.Range("U" & i).Value = DateAdd("m", 36, .Range("t" & i).Value)
Next i
End With
WorkPart
End Sub
Sub WorkPart()
'start date W (Material arrived date), count X (workdays since arrival), end count date Y (8D submitted)
Dim lastrow As Long, f As String
Debug.Print f
f = "=NetworkDays(RC[-1],IF(RC[1]>0,RC[1],Today()),lists!R2C3:R11C3)"
With ThisWorkbook.Sheets("open")
lastrow = .Cells(.Rows.Count, "s").Row
.Range("X3:X" & lastrow).FormulaR1C1 = f
End With
SubmittedD
End Sub
Sub SubmittedD()
'start date Y (8D Submission Date), count Z (Workdays since Submitted), end date AA (Customer Closed Date)
Dim lastrow As Long, f As String
Debug.Print f
f = "=NetworkDays(RC[-1],IF(RC[1]>0,RC[1],Today()),lists!R2C3:R11C3)"
With ThisWorkbook.Sheets("open")
lastrow = .Cells(.Rows.Count, "s").End(xlUp).Row
.Range("Z3:Z" & lastrow).FormulaR1C1 = f
End With
TotalCase
End Sub
Sub TotalCase()
'start date S (Start date), count AC (Total Workdays), end count date AA (Customer Closed Date)
Dim lastrow As Long, f As String
Debug.Print f
f = "=NetworkDays(RC[-10],IF(RC[-2]>0,RC[-2],Today()),lists!R2C3:R11C3)"
With ThisWorkbook.Sheets("open")
lastrow = .Cells(.Rows.Count, "S").End(xlUp).Row
.Range("AC3:AC" & lastrow).FormulaR1C1 = f
End With
FilterON
End Sub
Sub FilterON()
'
' FilterON
'
'
Rows("2:2").Select
Selection.AutoFilter
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
CleanItUp
End Sub
Sub CleanItUp()
'
' CleanItUp Makro
'
'
Application.Goto Reference:="R500C1:R160000C1"
Selection.EntireRow.Delete
Range("A2").Select
save
End Sub
Sub save()
'
' save Makro
'
'
ActiveWorkbook.save
MsgBox ("Updated")
End Sub