Code works but I have to run it 4 times

[Todd Huttenstine]

The following code works but I always have to run it 4
times before it deletes every value like its supposed to
do. Why does it not work 100% the first time I run it?

The code looks for blank values in a range in column D.
If it finds a blank value it selects that value through
the value in column A. It then deletes and shifts cells
up. It works but I have to run it 4 times before it finds
and deletes everything it should.


Dim RngUpld As Range
Dim CL As Object
Dim CountRecords As Long
Dim CLAddress1
Dim CLAddress2

CountRecords = Application.WorksheetFunction.Count
(Worksheets("4 Adjustment Upload File").Range("A:A")) + 1
Set RngUpld = Worksheets("4 Adjustment Upload File").Range
("D2" & CountRecords)

For Each CL In RngUpld
If CL.Value = "" Then
CLAddress1 = CL.Offset(0, -3).Address
CLAddress2 = CL.Address
Worksheets("4 Adjustment Upload File").Range
(CLAddress1 & ":" & CLAddress2).Select
Selection.Delete Shift:=xlUp
'Rows("5:5").Select
'Selection.EntireRow.Delete
Else
End If
Next

 

[Todd Huttenstine]

Oh nevermind I figured it out. If there are 2 or blank
values together, the code deltes the first and then moves
down to the next cell. If the cell under the first cell
was blank, it shift the next blank cell up and it caused
it to get skipped.

 

[kkknie]

The problem is that when you delete a row where there is another blan
in column D below it, the loop skips over the next row (since it ha
become the current row). Another way to handle this is to loop fro
the bottom like so:

Dim i As Long

For i = Range("D65536").End(xlUp).Row To 2 Step -1
If Range("D" & i).Value = "" Then Range("A" & i & "" & i).Delet
shift:=xlUp
Next

This should handle your specific issue.

 

[Bob Phillips]

Yes, so what do you need to do?

Work bottom up!

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Dana DeLouis]

If you would like, the later versions of Excel can do the following:

Sub Demo()
'// Dana DeLouis
Dim BigRng
Dim Rng

On Error Resume Next
ActiveSheet.UsedRange
Set BigRng = [D].SpecialCells(xlCellTypeBlanks).Offset(0, -3)
If BigRng Is Nothing Then Exit Sub

For Each Rng In BigRng.Areas
Rng.Resize(, 4).Delete xlUp
Next Rng
ActiveSheet.UsedRange ' Reset
End Sub