VBA Filter with criteria and offset

[Flakie]

Hello,

I am filtering column A (the only column in the sheet) for all rows that begins with an @ sign.
The delete all rows that do not start with an @ sign
I have some code which does this OK.

However I also want the filter to return the row directly above the one found with the @ sign.
And keep this row when the rest are deleted.

I am guessing I need to use offset in some way?
There will never be two rows next to each other that start with an @ sign so no additional sanity checking is needed.

Eventually I would like the row above, that does not contain the @ sign, to be moved to the column (B) next to its related one containing the @ sign. Hope this makes sense.
Guessing I have to use transpose here?

This si what i have so far:

    Set ws = ActiveWorkbook.Sheets("Testing")
    lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    Set rng = ws.Range("A1:A" & lastRow)
    With rng
        .AutoFilter Field:=1, Criteria1:="<>*@*"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    ws.AutoFilterMode = False

Is what I need available in Excel?
If so, is anyone able to help?

Many thanks,
Paul

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub Flakie()
   Dim Ar As Areas
   Dim i As Long
   
   With Sheets("Testing")
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1").AutoFilter 1, "*@*"
      Set Ar = .AutoFilter.Range.SpecialCells(xlVisible).Areas
      For i = 2 To Ar.Count
         Ar(i).Offset(, 1).Value = Ar(i).Offset(-1).Value
      Next i
      .Range("A1").AutoFilter 1, "<>*@*"
      .AutoFilter.Range.Offset(1).SpecialCells(xlVisible).EntireRow.Delete
      .AutoFilterMode = False
   End With
End Sub

 

[Flakie]

Many thanks for the quick reply.
This does stop the row above being deleted so thanks for that.
But it is leaving many rows that do not start with the @ sign.

There are 2360 rows in column A to start with.
After I run the code there are still 2355 rows.

Only 360 rows actually start with the @ sign.
So there should only be 720 rows remaining.

If i run the same code on the data again it deletes one or two more rows each time i run it.

Any ideas?

 

[Fluff]

Do you have any blank rows in the data?

 

[Flakie]

Yes about 10% are blank

 

[Fluff]

In that case try

Sub Flakie()
   Dim Ar As Areas
   Dim i As Long, Lr As Long
   
   With Sheets("Testing")
      If .AutoFilterMode Then .AutoFilterMode = False
      Lr = .Range("A" & Rows.Count).End(xlUp).Row
      .Range("A1:A" & Lr).AutoFilter 1, "*@*"
      Set Ar = .AutoFilter.Range.SpecialCells(xlVisible).Areas
      For i = 2 To Ar.Count
         Ar(i).Offset(, 1).Value = Ar(i).Offset(-1).Value
      Next i
      .Range("A1:A" & Lr).AutoFilter 1, "<>*@*"
      .AutoFilter.Range.Offset(1).SpecialCells(xlVisible).EntireRow.Delete
      .AutoFilterMode = False
   End With
End Sub

 

[Flakie]

Ah thanks. Found some code to delete all the blank rows first. If I delete all the blank rows first this works a treat

Cheers

 

[Fluff]

You're welcome & thanks for the feedback

 

[Flakie]

Sorry missed this post. Yes this is much more elegant than what i had and works really well.

Many thanks again

 

[Fluff]

Glad to help