added functionality

[ksnapp]

I need to modify this code a little bit

Sub DeleteRESERVE() ' deltes rows with reserve in column 3
Const cColumn = 3, cSearch = "RESERVE"
Dim i As Long, lngLastRow As Long
With ActiveSheet
lngLastRow = .Cells(Rows.Count, cColumn).End(xlUp).Row
For i = lngLastRow To 1 Step -1
If InStr(1, .Cells(i, cColumn).Value, cSearch) > 0 Then
.Rows(i).Delete xlShiftUp
End If
Next
End With
End Sub

If there is anything in column a of the same row, i need those content
copy pasted down one row. If the cell in column A is blank I i
doesn't need to do anything

 

[pikus]

If Cells(i, 1).Value <> "" Then
Cells(i + 1, 1).Value = Cells(i, 1).Value
End If

- Piku

 

[ksnapp]

where does that go, I tried at the end after the end if?
thank

 

[Tom Ogilvy]

Sub DeleteRESERVE() ' deltes rows with reserve in column 3
Const cColumn = 3, cSearch = "RESERVE"
Dim i As Long, lngLastRow As Long
With ActiveSheet
lngLastRow = .Cells(Rows.Count, cColumn).End(xlUp).Row
For i = lngLastRow To 1 Step -1
If InStr(1, .Cells(i, cColumn).Value, cSearch) > 0 Then
if not isempty(cells(i,"A")) then
cells(i+1,"A").Value = cells(i,"A").Value
End if
Rows(i).Delete xlShiftUp
End If
Next
End With
End Sub