Macro that deletes all rows that does not contain ## or **

[mingandmong]

Hi
I'm using excel 2010

I need a macro that deletes all rows after row 10 that does not contain these special characters as shown

## and ** that are always on separate rows on a data log file I just need to strip all redundant data

Thank-you in advance

 

[cooper645]

Hi Mingandmong,

I have come up with the following code;

I have assumed that the ## and ** are one or the other and they are the only contents of the cell, and that they are in column A.

If this is all correct the below code should work for you,

If the column is different, then amend the red A for the column letter, and the red 1 for the column number.

If there are more conditions then please let us know so we can develop this into a working solution.

Sub DeleteCriteriaRows()

Dim LastRow As Long, i As Integer


LastRow = Cells(Rows.Count, "[B][COLOR=#ff0000]A[/COLOR][/B]").End(xlUp).Row


For i = LastRow To 11 Step -1
         If Cells(i, [B][COLOR=#ff0000]1[/COLOR][/B]).Value = "##" Then
            GoTo Move
         ElseIf Cells(i, [B][COLOR=#ff0000]1[/COLOR][/B]).Value = "**" Then
         GoTo Move
         End If
         Cells(i, [B][COLOR=#ff0000]1[/COLOR][/B]).EntireRow.Delete
Move:     Next i


End Sub

Kind regards,

Coops

 

[Peter_SSs]

If the suggested solution does not work for you or takes too long to process, please include further details about
- exactly what might be in the cells in question (examples?)
- are we only looking for those values in one column or multiple columns [which one(s)]?
- about how many rows altogether in your data?

 

[mingandmong]

Hi Coops

Unfortunately it deleted all my data after row 10,

Yes the data is in column A,

I have posted a sample of the data it may be that I have random strings of data in-between ## and ** perhaps this is the reason below is a sample of data in column A all data is in one row I have shown current and expected results below

<tbody>
</tbody>

Current

(23/02/17 17:17:20 ) 17:31:26.969 - 2187687604: ##XXXXXXXXXXXX ##
(23/02/17 17:17:50 ) 17:17:39.549 - 2754899072: Got to catch a bus
(23/02/17 17:17:50 ) 17:17:39.016 - 2753567789839:Speaking Clock: **XXX**
(23/02/17 17:17:50 ) 17:17:39.690 - 67587984213: train timetable is optimal
(23/02/17 17:17:35 ) 17:17:27.230 - 2771753: ##XXXXXXXXXXXX ##
(23/02/17 17:17:50 ) 17:17:39.691 - 27589004214: EVENT -- triggered by missing the bus
(23/02/17 17:17:50 ) 17:17:41.047 - 27576885571: Groceries are now ordered
(23/02/17 17:17:20 ) 17:14:59.772 - 36365654395: ##XXX(XXXXX)##
(23/02/17 17:17:50 ) 17:17:41.221 - 47567895744: Stock exchange
(23/02/17 17:17:50 ) 17:17:41.222 - 1755745: EVENT -- today please visit
(23/02/17 17:17:35 ) 17:17:21.536 - 27366546059: Collection Done: **XX**

<tbody>
</tbody>

Expeted results

(23/02/17 17:17:20 ) 17:31:26.969 - 2187687604: ##XXXXXXXXXXXX ##
(23/02/17 17:17:50 ) 17:17:39.016 - 2753567789839:Speaking Clock: **XXX**
(23/02/17 17:17:35 ) 17:17:27.230 - 2771753: ##XXXXXXXXXXXX ##
(23/02/17 17:17:20 ) 17:14:59.772 - 36365654395: ##XXX(XXXXX)##
(23/02/17 17:17:35 ) 17:17:21.536 - 27366546059: Collection Done: **XX**

<tbody>
</tbody>

 

[mingandmong]

Hi Peter

i have replied to my post
the data is in column A
approx 5000 rows

 

[Peter_SSs]

OK, thanks. Try this in a copy of your workbook.

Sub DelRws()
  Application.ScreenUpdating = False
  With Range("A10", Range("A" & Rows.Count).End(xlUp))
    .AutoFilter Field:=1, Criteria1:="<>*##*##*", Operator:=xlAnd, Criteria2:="<>*~*~**~*~**"
    .Offset(1).EntireRow.Delete
  End With
  ActiveSheet.AutoFilterMode = False
  Application.ScreenUpdating = True
End Sub

Before

Book1
	A
9
10	Current
11	(23/02/17 17:17:20 ) 17:31:26.969 - 2187687604: ##XXXXXXXXXXXX##
12	(23/02/17 17:17:50 ) 17:17:39.549 - 2754899072: Got to catch a bus
13	(23/02/17 17:17:50 ) 17:17:39.016 - 2753567789839:Speaking Clock: **XXX**
14	(23/02/17 17:17:50 ) 17:17:39.690 - 67587984213: train timetable is optimal
15	(23/02/17 17:17:35 ) 17:17:27.230 - 2771753: ##XXXXXXXXXXXX##
16	(23/02/17 17:17:50 ) 17:17:39.691 - 27589004214: EVENT -- triggered by missing the bus
17	(23/02/17 17:17:50 ) 17:17:41.047 - 27576885571: Groceries are now ordered
18	(23/02/17 17:17:20 ) 17:14:59.772 - 36365654395: ##XXX(XXXXX)##
19	(23/02/17 17:17:50 ) 17:17:41.221 - 47567895744: Stock exchange
20	(23/02/17 17:17:50 ) 17:17:41.222 - 1755745: EVENT -- today please visit
21	(23/02/17 17:17:35 ) 17:17:21.536 - 27366546059: Collection Done: **XX**
Del Rows

After

Book1
	A
10	Current
11	(23/02/17 17:17:20 ) 17:31:26.969 - 2187687604: ##XXXXXXXXXXXX##
12	(23/02/17 17:17:50 ) 17:17:39.016 - 2753567789839:Speaking Clock: **XXX**
13	(23/02/17 17:17:35 ) 17:17:27.230 - 2771753: ##XXXXXXXXXXXX##
14	(23/02/17 17:17:20 ) 17:14:59.772 - 36365654395: ##XXX(XXXXX)##
15	(23/02/17 17:17:35 ) 17:17:21.536 - 27366546059: Collection Done: **XX**
16
Del Rows

 

[mingandmong]

Thank-you Peter
that has worked,

Thankyou coops aswell

 

[Peter_SSs]

Thank-you Peter
that has worked,

You are welcome. If you happen to end up with much larger data and that code is taking too long to execute, there are faster ways (but not worth worrying about unless speed becomes an issue for you. )

 

[mingandmong]

Hi Peter
i would like to add another criteria, i ammened your code but it appears not to be a simple task and i get a debug error
the 3rd citeria i need is rows that contain the carret ^^ symbol (they are open ended and dont close like the other 2 criteria ##XXX ## **XXX**) and there is a caveat to this as well
extra data row to retain = ^^XXX XX XXX >
rows not to retain also have the carret sign, they also always have the <XXX....> directley after the symbol^^ so not sure if you can use a wildcard after the ^^

i tried this so please have a laugh
.AutoFilter Field:=1, Criteria1:="<>*##*##*", Operator:=xlAnd, Criteria2:="<>*~*~**~*~**", Operator:=xlAnd, Criteria3:="<>*^^*"
Many thanks again in advance

below is the current & expected results i have redacted the data

Current

(23/02/17 17:17:20 ) 17:31:26.969 - 2187687604: ##XXX XXXXXXXXX ##

(23/02/17 17:17:50 ) 17:17:39.549 - 2754899072: Got to catch a bus

(23/02/17 17:17:50 ) 17:17:39.016 - 2753567789839:Speaking Clock: **XXX**

(23/02/17 17:17:50 ) 17:17:39.690 - 67587984213: train timetable is optimal

(23/02/17 17:17:35 ) 17:17:27.230 - 2771753: ##XXX XXXXXXXXX ##

(23/02/17 17:17:50 ) 17:17:39.691 - 27589004214: EVENT -- triggered by missing the bus

(23/02/17 17:17:50 ) 17:17:41.047 - 27576885571: Groceries are now ordered

(23/02/17 17:17:20 ) 17:14:59.772 - 36365654395: ##XXX (XXXXX)##

(23/02/17 17:17:50 ) 17:17:41.221 - 47567895744: Stock exchange

(23/02/17 17:17:50 ) 17:17:41.222 - 1755745: EVENT -- today please visit

(23/02/17 17:17:35 ) 17:17:21.536 - 27366546059: Collection Done: **XX**

(23/02/17 17:17:50 ) 17:17:41.222 - 1755745: ^^XXX XXX XXX >XXX << out of stock

(23/02/17 17:17:35 ) 17:17:21.536 - ^^<XXX> XXX XXX >XXX <train departing ontime <colgroup><col width="605"></colgroup><tbody> </tbody>

After

(23/02/17 17:17:20 ) 17:31:26.969 - 2187687604: ##XXX XXXXXXXXX ##

(23/02/17 17:17:50 ) 17:17:39.016 - 2753567789839:Speaking Clock: **XXX**

(23/02/17 17:17:35 ) 17:17:27.230 - 2771753: ##XXX XXXXXXXXX ##

(23/02/17 17:17:20 ) 17:14:59.772 - 36365654395: ##XXX (XXXXX)##

(23/02/17 17:17:35 ) 17:17:21.536 - 27366546059: Collection Done: **XX**

(23/02/17 17:17:50 ) 17:17:41.222 - 1755745: ^^XXX XXX XXX >XXX << out of stock

<tbody>
</tbody>

 

[Peter_SSs]

i tried this so please have a laugh
.AutoFilter Field:=1, Criteria1:="<>*##*##*", Operator:=xlAnd, Criteria2:="<>*~*~**~*~**", Operator:=xlAnd, Criteria3:="<>*^^*"

No laughing - your attempt was very logical & it is good to have a try yourself as it is good for learning.
The only problem is with vba in that AutoFilter used like that only allows a maximum of 2 criteria.

See if this modification does what you want. I have added the 3 blue lines and moved the red one.

Sub DelRws_v2()
  Application.ScreenUpdating = False
  With Range("A10", Range("A" & Rows.Count).End(xlUp))
    .Replace What:="^^<*>", Replacement:="", LookAt:=xlPart
    .Replace What:="^^", Replacement:="##^^##", LookAt:=xlPart
    .AutoFilter Field:=1, Criteria1:="<>*##*##*", Operator:=xlAnd, Criteria2:="<>*~*~**~*~**"
    .Offset(1).EntireRow.Delete
    ActiveSheet.AutoFilterMode = False
    .Replace What:="##^^##", Replacement:="^^", LookAt:=xlPart
  End With
  Application.ScreenUpdating = True
End Sub