Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.
One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.
Sub Insert_Delete_Rows() Dim Ws1 As Worksheet, Ws2 As Worksheet Dim LR1 As Long, LR2 As Long Dim MyCount1 As Integer, MyCount2 As Integer, RowDiff As Integer Dim MyRange As Range Application.ScreenUpdating = False Set Ws1 = Worksheets("Aging_Report") Set Ws2 = Worksheets("Statement_Template") LR1 = Ws1.Range("C" & Rows.Count).End(xlUp).row LR2 = Ws2.Range("C" & Rows.Count).End(xlUp).row Set MyRange = Ws2.Range("C24:C" & LR2) MyCount1 = Application.WorksheetFunction.CountIfs(Ws1.Range("D3:D" & LR1), Ws2.Range("A12").value, Ws1.Range("B3:B" & LR1), Ws2.Range("J1").value) Ws2.Range("N1").value = MyCount1 MyCount2 = Application.WorksheetFunction.CountA(MyRange) Ws2.Range("O1").value = MyCount2 If MyCount1 = MyCount2 Then Exit Sub ElseIf MyCount1 > MyCount2 Then RowDiff = MyCount1 - MyCount2 Ws2.Range("A25:H25").EntireRow.Copy Ws2.Range("A30:A" & RowDiff + 2).EntireRow.Insert Application.CutCopyMode = False ElseIf MyCount1 < MyCount2 Then RowDiff = MyCount2 - MyCount1 Ws2.Range("A30" & RowDiff + 2).Delete shift:=xlUp End If Application.ScreenUpdating = True End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.