The FORMAT of cells in Col D to "Accounting" gave me a good run. After editing the format things moved along rather well.
Public Sub PD()
'''rename sheet'''
Dim newName As String
On Error Resume Next
newName = InputBox("Enter the name for the copied worksheet")
'''duplicate current tab'''
If newName <> "" Then
ActiveSheet.Copy Before:=Sheets(1)
On Error Resume Next
ActiveSheet.Name = newName
End If
Application.ScreenUpdating = False
'''copy end of period balances from I9 to last cell with data in row H5'''
Dim lastRow As Long
lastRow = Range("H3").End(xlDown).Row
Set Rng = Range("H3:H" & lastRow)
Range("H3:H" & lastRow).Copy
'''paste copied end balances and paste values to cell D5'''
ActiveSheet.Range("D3").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Applcation.CutCopyMode = False
'''insert 50 blank rows to make space for new period data'''
'''grabs count of new accruals for period from cell N1'''
Dim var As Integer
var = 200
Range("H" & lastRow).EntireRow.Offset(1).Resize(var).Insert Shift:=xlDown
Range("D1:D200").NumberFormat = "Number"
'''deletes rows with zero values in column D'''
Dim Sht As Worksheet
Dim last As Long
Set Sht = ActiveSheet
last = Sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = last To 30 Step -1
If Cells(i, "D").Value = "0" Then
Cells(i, "D").EntireRow.Delete
End If
Next i
Dim LR As Long
Application.ScreenUpdating = False '\/Change number 1 below to correspond to affected column.
LR = Sheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row '<----- Change to actual sheet name
With Range("D2:D200" & LR) '<-- Change to corresponding row
.Replace 0, "", xlWhole '<-- Currently checking for number 0. Edit as required
.SpecialCells(4).EntireRow.Delete
End With
Range("E3:E200" & LR).ClearContents '<-- Change to corresponding row
Dim wbMe As Excel.Workbook
Dim cl As Excel.Range
Set wbMe = ThisWorkbook
'if number is negative, change to positive
Set cl = activeworksheet.Range("D3:D200").Select
If cl.Value < 0 Then
cl.Value = -cl.Value
End If
'clear the totals at bottom of ranges
LR = Range("A3").End(xlDown).Row
Rows(LR + 1 & ":" & 10000).Delete
Application.ScreenUpdating = True
End Sub