Loop to Selection.Delete Shift:=xlUp

[Leandroarb]

Hi,
Please, a need delete cells equal "*".
I try use this code:

Sub DelTry()
On Error Resume Next
Do While ActiveCell <> ""
    If ActiveCell.Value <> "*" Then
    ActiveCell.Offset(1, 0).Select
    Else
    Selection.Delete Shift:=xlUp
    End If
Loop
End Sub

But... suceless

The datas are in columns

[TABLE="width: 83"]
<tbody>[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]03/11/2018[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]04/11/2018[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]15/11/2018[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]02/11/2018[/TD]
[/TR]
[TR]
[TD]10/11/2018[/TD]
[/TR]
[TR]
[TD]11/11/2018[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]17/11/2018[/TD]
[/TR]
[TR]
[TD]18/11/2018[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]24/11/2018[/TD]
[/TR]
[TR]
[TD]25/11/2018[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
[TR]
[TD]*[/TD]
[/TR]
</tbody>[/TABLE]

Every form of help is appreciated.
Thank you.

 

[Joe4]

I think part of the problem is "*" can be confused with the wildcard.
The "*" is ASCII character 42. So one way of doing this is to check for a length of one, and the ASCII code of that character be 42.
Also, you code will be much faster if you avoid using SELECT statements (which are not necessary).
Try this:

Sub DelTry()
    
    Dim lrow As Long
    Dim r As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
'   Find column of active cell
    c = ActiveCell.Column
    
'   Find last row with data in active column
    lrow = Cells(Rows.Count, c).End(xlUp).Row
    
'   Loop through all rows from bottom to top
    For r = lrow To 1 Step -1
        If (Len(Cells(r, c)) = 1) And (Asc(Left(Cells(r, c), 1)) = 42) Then
            Rows(r).Delete
        End If
    Next r
                
    Application.ScreenUpdating = True
    
End Sub

 

[jproffer]

This will do what I think you want to do. Please test on a COPY though the first time through.

Sub test()
Dim LastRow As Long
Dim i As Long

LastRow = Range("A" & Rows.Count).End(xlUp).Row

For i = LastRow To 1 Step -1
    If Range("A" & i).Value = "*" Then
        Range("A" & i).EntireRow.Delete
    End If
Next i



End Sub

 

[Leandroarb]

Thank you Joe,
The problem is that it is deleting the whole line, and there are dozens of columns next to it. Only the cell has to be deleted.
Thank you very much for your help.

 

[Joe4]

The problem is that it is deleting the whole line, and there are dozens of columns next to it. Only the cell has to be deleted.

Sorry, I missed that.

That is an easy fix:
Sub DelTry()
    
    Dim lrow As Long
    Dim r As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
'   Find column of active cell
    c = ActiveCell.Column
    
'   Find last row with data in active column
    lrow = Cells(Rows.Count, c).End(xlUp).Row
    
'   Loop through all rows from bottom to top
    For r = lrow To 1 Step -1
        If (Len(Cells(r, c)) = 1) And (Asc(Left(Cells(r, c), 1)) = 42) Then
            Cells(r, c).Delete Shift:=xlUp
        End If
    Next r
                
    Application.ScreenUpdating = True
    
End Sub

 

[jproffer]

Me too. Don't use mine either. Sorry about that.

 

[Leandroarb]

Wowwwwwww Joe, thanks very mutch in absolute!
Great master!

Sorry, I missed that.

That is an easy fix:
Sub DelTry()
    
    Dim lrow As Long
    Dim r As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
'   Find column of active cell
    c = ActiveCell.Column
    
'   Find last row with data in active column
    lrow = Cells(Rows.Count, c).End(xlUp).Row
    
'   Loop through all rows from bottom to top
    For r = lrow To 1 Step -1
        If (Len(Cells(r, c)) = 1) And (Asc(Left(Cells(r, c), 1)) = 42) Then
            Cells(r, c).Delete Shift:=xlUp
        End If
    Next r
                
    Application.ScreenUpdating = True
    
End Sub

 

[Joe4]

OK, so apparently I was wrong in that it would treat the asterisk as a wild-card, and the IF statement that jproffer shows would work also (and is a bit simpler).
So, using that logic he used, my solution can be simplified to:

Sub DelTry()
    
    Dim lrow As Long
    Dim r As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
'   Find column of active cell
    c = ActiveCell.Column
    
'   Find last row with data in active column
    lrow = Cells(Rows.Count, c).End(xlUp).Row
    
'   Loop through all rows from bottom to top
    For r = lrow To 1 Step -1
        If Cells(r, c).Value = "*" Then
            Cells(r, c).Delete Shift:=xlUp
        End If
    Next r
                
    Application.ScreenUpdating = True
    
End Sub

The other main difference between our codes is that jproffer's always looks at column A, and mine runs against whatever column the ActiveCell is in.
If you are always looking in one particular pre-defined column, I recommend taking his approach (fixing up the delete line).
If you could be in different columns and want it to run against the active one, then use mine.

 

[Leandroarb]

No problem dear collaborator, I really appreciate your willingness to help.

Me too. Don't use mine either. Sorry about that.

 

[Joe4]

Wowwwwwww Joe, thanks very mutch in absolute!

You are very welcome.

By the way, do you happen to be a basketball fan?
https://en.wikipedia.org/wiki/Leandro_Barbosa