I don't think rng is populating properly.
I've tried to run this and rng always = 0, never the range that it
should contain.
I don't know why it doesn't work but I worked around it;

Sub Macro4()
Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
Dim MyRng As Range

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Msg = "Please Check You Have Loaded The Label Paper Correctly - " &
_
vbCr & "Labels Will Be Sent To Printer - All Data Will Be Deleted " & _
vbCr & vbCr & "Click OK When You Are Ready To Proceed"
MsgBox Prompt:=Msg
With ActiveSheet
.DisplayPageBreaks = False
StartRow = 2
EndRow = 5000
ZeroCells = 0
For Lrow = StartRow To EndRow Step 1
If IsError(.Cells(Lrow, "B").Value) Then
'Do nothing, This avoid a error if there is a error in
the cell
ElseIf .Cells(Lrow, "B").Value = "0" Then
'Set MyRng = Application.Union(MyRng, .Cells(Lrow,
"B"))
If ZeroCells 0 Then
Application.Union(Selection, .Cells(Lrow, "B")).Select
Else
Cells(Lrow, "B").Select
End If
ZeroCells = ZeroCells + 1
End If
Next
End With
'hide all rows in one time
If Not Selection Is Nothing Then Selection.EntireRow.Hidden = True

With Application
.ScreenUpdating = True
.Calculation = CalcMode
Application.Run Macro:="Macro5"
MyRng.EntireRow.Hidden = False

End With
End Sub


Which seems to work.