0

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 
marc_s
  • 732,580
  • 175
  • 1,330
  • 1,459
  • Possibly helpful - [Find last used cell in Excel VBA](https://stackoverflow.com/questions/11169445/find-last-used-cell-in-excel-vba/49971540#49971540) ? – T.M. Mar 19 '23 at 09:51
  • In `Sub WorkPart()` `lastrow = .Cells(.Rows.Count, "s").Row` is missing `.End(xlUp)` ie `lastrow = .Cells(.Rows.Count, "S").End(xlUp).Row` – CDP1802 Mar 19 '23 at 11:40

0 Answers0