skip code if not blank cell

[omairhe]

peace all,

with the code :=

    Range("1:1,51:51,101:101,151:151").Delete Shift:=xlUp

how to check individual range from above if blank or not, and then apply deletion to that particular range.

for instance


1:1 = not blank, then skip code
51:51 = blank, then delete shift:=xlUp
101:101 = not blank, then skip code
151:151 = not blank, then skip code

 

[Mindpsyche]

Re-checking code.

 

[Mindpsyche]

Ok try this:

Let me know if this works ok.

Sub delrow()
    Dim x As Long
    Dim y As Long
    Dim r As Range
    For x = 151 To 1 Step -50
        Cells(x, x).Select
        Set r = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, Columns.Count).End(xlToLeft))
        r.Select
        y = Application.WorksheetFunction.CountA(r)
        If y = 0 Then
        ActiveCell.EntireRow.Delete shift:=xlShiftUp
    End If
    Next x
End Sub

 

[omairhe]

Ok try this:

Let me know if this works ok.

Sub delrow()
    Dim x As Long
    Dim y As Long
    Dim r As Range
    For x = 151 To 1 Step -50
        Cells(x, x).Select
        Set r = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, Columns.Count).End(xlToLeft))
        r.Select
        y = Application.WorksheetFunction.CountA(r)
        If y = 0 Then
        ActiveCell.EntireRow.Delete shift:=xlShiftUp
    End If
    Next x
End Sub

It does delete a single row... however what if at row 151 there are consecutive blanks untill row 156. Then the value in 157. This requires a loop I think ? thanks for the effort .

 

[Mindpsyche]

Firstly, no probs...got a relaxed day at work.

By the way, please copy paste the code again and try as I have changed the Count to a CountA.

Also, as per your code, you were only checking rows 1, 51, 101, 151....Do you need it to check all rows and see if any row is blank then delete it?

This code does not go beyond row 151, in fact it starts at 151 and then moves downwards to rows 101, 51 and 1...

Can you be a little more clear?

 

[omairhe]

The code do just what I asked for but there was incomplete information of what I required.

Firstly, no probs...got a relaxed day at work.

By the way, please copy paste the code again and try as I have changed the Count to a CountA.

Also, as per your code, you were only checking rows 1, 51, 101, 151....Do you need it to check all rows and see if any row is blank then delete it?

This code does not go beyond row 151, in fact it starts at 151 and then moves downwards to rows 101, 51 and 1...

Can you be a little more clear?

my sheet has only consecutive blank rows. meaning there are always more than single blank rows and they are adjoined together in group. shift xl down can select all but the non-empty blank cells when selected from row 1, 51 and 151. and so on..




for instance.

row

51....blank
52....blank
53....blank
54....1a
55....2a
56....blank
56....blank
57....3a


after code
51....1a
52....2a
52....blank
53....blank
54....3a

Now that 51 is not blank so skip the code and check for row 101 and repeat like a loop until 151 ..

sorry for the delay...

 

[Mindpsyche]

So let me get this right:

I should begin by checking Row1, If Row 1 is blank then delete row1 and all following consecutive rows, until row1 is not blank?

Then once Row 1 is not blank, move to Row 51 and do the same? i.e. if Row 51 is blank, then delete row 51 and all following blank rows until Row 51 is non blank.

Then move to row 101?

 

[omairhe]

Yes, exactly

So let me get this right:

I should begin by checking Row1, If Row 1 is blank then delete row1 and all following consecutive rows, until row1 is not blank?

Then once Row 1 is not blank, move to Row 51 and do the same? i.e. if Row 51 is blank, then delete row 51 and all following blank rows until Row 51 is non blank.

Then move to row 101?

 

[Mindpsyche]

Ok not completely tested as I could only imagine what your data looks like:

Also, i am sure this could be done very easily some other way..but this is the best i could do.

This is on excel 2003 which has a maximum of 255 columns (if your using higher versions, then just substitute 255 with the maximum number of columns allowed in your version).

Sub Delete()
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim lr As Long
    Dim cellrow As Range
    
    For x = 1 To 151 Step 50
        
            Cells(x, 1).Select
            Set cellrow = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 255))
            z = Application.WorksheetFunction.CountA(cellrow)
            lr = Range(Cells(x, 1), Cells(x, 1).End(xlDown)).Count
            
            If z = 0 Then
            For y = 1 To lr
            Set cellrow = cellrow.Resize(y)
            cellrow.Select ' Checking resize
            z = Application.WorksheetFunction.CountA(cellrow)
            If z = 1 Then
            Set cellrow = cellrow.Resize(y - 1)
            cellrow.Delete shift:=xlShiftUp
            y = lr
            End If
            Next y
            End If
    Next x
End Sub

 

[Mindpsyche]

Updated with some corrections.

Sub Delete()
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim lr As Long
    Dim cellrow As Range
    
    For x = 1 To 151 Step 50
        
            Cells(x, 1).Select
            Set cellrow = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 255))
            z = Application.WorksheetFunction.CountA(cellrow)
            lr = Range(Cells(x, 1), Cells(x, 1).End(xlDown)).Count
            
            If z = 0 Then
            For y = 1 To lr
            Set cellrow = cellrow.Resize(y)
            cellrow.Select ' Checking resize
            z = Application.WorksheetFunction.CountA(cellrow)
            If z > 0 Then
            Set cellrow = cellrow.Resize(y - 1)
            cellrow.Delete shift:=xlShiftUp
            y = lr
            End If
            Next y
            End If
    Next x
End Sub

[/QUOTE]