Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code works but I have to run it 4 times
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:D" & 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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code works but I have to run it 4 times
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. -----Original Message----- 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:D" & 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 . |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code works but I have to run it 4 times
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 & ":D" & i).Delet shift:=xlUp Next This should handle your specific issue. -- Message posted from http://www.ExcelForum.com |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code works but I have to run it 4 times
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) "Todd Huttenstine" wrote in message ... 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. -----Original Message----- 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:D" & 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 . |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code works but I have to run it 4 times
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: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 -- Dana DeLouis Using Windows XP & Office XP = = = = = = = = = = = = = = = = = "Todd Huttenstine" wrote in message ... 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. -----Original Message----- 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:D" & 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 . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
code works - need to save | Excel Discussion (Misc queries) | |||
IF logic only works 7 times | Excel Worksheet Functions | |||
Why won't this code works | Excel Programming | |||
VBA Code Works in 97, Not in 2002 | Excel Programming | |||
RPC ERROR - 1ST TIMES WORKS FINE - 2ND TIME ERRORS OUT | Excel Programming |