Keeping key words in row data and delete the rest of the rows Macro updating Please

[mingandmong]

Good Afternoon
could someone please update my Macro below
it only keeps row data that contains data between ## ^^ **

i would like to replace with the following 3 unique data starting in A10 down

MON:
Data Sent
SURVEY:

many thanks

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

 

[Peter_SSs]

The question is not clear to me.
Perhaps we could have a small set of sample data , expected results and explanation in relation to that sample data?

 

[mingandmong]

Hi Peter_SSs
Thankyou for posting
here is a link to the origanal macro on mr Excel written by a good friend of yours
i just need to replace the 3 critera of kept data rows from ## ^^ ** and replace with MON: Data Sent & SURVEY:
so basicly out of 5000 rows of data i just want to keep rows that contain the 3 new criteria and delete the rest
thank you

https://www.mrexcel.com/forum/excel-questions/1044912-macro-deletes-all-rows-does-not-contain.html

 

[mingandmong]

(23/02/17 17:17:20 ) 17:31:26.969 - 2187687604: Data Sent: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: MON: XXXXXX
(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: MON:XXXXXX
(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: SURVEY: 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:SURVEY:XXXXXXX
Expeted results
(23/02/17 17:17:20 ) 17:31:26.969 - 2187687604: DATA SENT:XXXXXXXXX
(23/02/17 17:17:50 ) 17:17:39.016 - 2753567789839:Speaking Clock: MON: XXXXXX
(23/02/17 17:17:35 ) 17:17:27.230 - 2771753: MON:XXXXXX
(23/02/17 17:17:50 ) 17:17:39.691 - 27589004214: EVENT -- triggered by missing the bus
(23/02/17 17:17:20 ) 17:14:59.772 - 36365654395: SURVEY: XXX(XXXXX)
(23/02/17 17:17:35 ) 17:17:21.536 - 27366546059: Collection Done:SURVEY:XXXXXXX

<colgroup><col style="mso-width-source:userset;mso-width-alt:11690;width:247pt" width="329"> <col style="width:48pt" width="64" span="7"> </colgroup><tbody>
</tbody>

 

[Peter_SSs]

See if this does what you want.

Sub keepRows()
  Dim myVals As Variant, itm As Variant
  
  myVals = Split("MON:|Data Sent|SURVEY:", "|")
  Application.ScreenUpdating = False
  With Range("A10", Range("A" & Rows.Count).End(xlUp))
    For Each itm In myVals
      .Replace What:=itm, Replacement:="%%%" & itm, LookAt:=xlPart, MatchCase:=False
    Next itm
    .AutoFilter Field:=1, Criteria1:="<>%%%*"
    .Offset(1).EntireRow.Delete
    ActiveSheet.AutoFilterMode = False
    .Replace What:="%%%", Replacement:="", LookAt:=xlPart
  End With
  Application.ScreenUpdating = True
End Sub

 

[mingandmong]

Hi Peter_SSs
Form some reason its deleted all data after Row 10
none of the rows of data containg them 3 specific words have been retained

 

[Peter_SSs]

Hi Peter_SSs
Form some reason its deleted all data after Row 10
none of the rows of data containg them 3 specific words have been retained

My mistake, I mis-read your request and thought the rows had to start with those texts ( & I hadn't seen post 4 when I drafted my code).
It is a simple fix, just add this red asterisk

.AutoFilter Field:=1, Criteria1:="<>*%%%*"

 

[mingandmong]

Hi Peter_SSs
adding the * has resolved the issue many thanks for helping me out once again

 

[Peter_SSs]

Hi Peter_SSs
adding the * has resolved the issue many thanks for helping me out once again

No problem, glad to help.

 

[mingandmong]

Hi All
can anyone show me how to modify the following code i need to modify this part Split(": ##|^^|SURVEY:", "|")
it deletes all line text except lines that contain ## ^^ & SURVEY
it now needs to delete all txt lines that contain ^^< but not lines with ^^ as in the top 3 lines below however i need to keep the 4th line ^^
there are 1000's of lines

before

(03/04/20 08:59:32 BST) 07:41:20.601 - 6290290: ^^<wc> 893 -1.00 <0.00 <@@q4RwTd89dvSc2HdhxyV8TOdsKtVGJITOBWJYiaPTguu0x+ieispgSQ==

(03/04/20 08:59:32 BST) 07:41:23.244 - 6292933: ^^<sil> 893 -1.00 <0.00 <@@q4RwTd89dvRJWxvMrDDQOOdsKtVGJITOj9fEmrEg/Au0x+ieispgSQ==

(03/04/20 08:59:32 BST) 07:41:23.245 - 6292934: ^^<garbage00> 893 -1.00 <0.00 <@@q4RwTd89dvSSUl14aSQS9+dsKtVGJITOQ159cfSkNqq0x+ieispgSQ==

(03/04/20 08:59:32 BST) 07:41:23.339 - 6293028: ^^okay 893 0.19 >0.00 <@@q4RwTd89dvQVs7mIBxe/hedsKtVGJITOBsQXP3UATcK0x+ieispgSQ==

After
(03/04/20 08:59:32 BST) 07:41:23.339 - 6293028: ^^okay 893 0.19 >0.00 <@@q4RwTd89dvQVs7mIBxe/hedsKtVGJITOBsQXP3UATcK0x+ieispgSQ==


Sub keepRows()
Dim myVals As Variant, itm As Variant

myVals = Split(": ##|^^|SURVEY:", "|")
Application.ScreenUpdating = False
With Range("A10", Range("A" & Rows.Count).End(xlUp))
For Each itm In myVals
.Replace What:=itm, Replacement:="%%%" & itm, LookAt:=xlPart, MatchCase:=False
Next itm
.AutoFilter Field:=1, Criteria1:="<>*%%%*"
.Offset(1).EntireRow.Delete
ActiveSheet.AutoFilterMode = False
.Replace What:="%%%", Replacement:="", LookAt:=xlPart
End With
Application.ScreenUpdating = True
End Sub