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

mingandmong

Active Member
Joined
Oct 15, 2014
Messages
339
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
Code:
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
 
Last edited by a moderator:

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
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?
 
Upvote 0
Last edited:
Upvote 0
Expeted results

<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>
[TD="width: 713, colspan: 7"](23/02/17 17:17:20 ) 17:31:26.969 - 2187687604: Data Sent:XXXXXXXXX[/TD]
[TD="class: xl65, width: 64"][/TD]

[TD="class: xl65, width: 713, colspan: 7"](23/02/17 17:17:50 ) 17:17:39.549 - 2754899072: Got to catch a bus[/TD]
[TD="class: xl65, width: 64"][/TD]

[TD="class: xl65, width: 777, colspan: 8"](23/02/17 17:17:50 ) 17:17:39.016 - 2753567789839:Speaking Clock: MON: XXXXXX[/TD]

[TD="class: xl65, width: 777, colspan: 8"](23/02/17 17:17:50 ) 17:17:39.690 - 67587984213: train timetable is optimal[/TD]

[TD="colspan: 7"](23/02/17 17:17:35 ) 17:17:27.230 - 2771753: MON:XXXXXX[/TD]
[TD="class: xl65, width: 64"][/TD]

[TD="class: xl65, width: 777, colspan: 8"](23/02/17 17:17:50 ) 17:17:39.691 - 27589004214: EVENT -- triggered by missing the bus[/TD]

[TD="class: xl65, width: 777, colspan: 8"](23/02/17 17:17:50 ) 17:17:41.047 - 27576885571: Groceries are now ordered[/TD]

[TD="class: xl65, width: 713, colspan: 7"](23/02/17 17:17:20 ) 17:14:59.772 - 36365654395: SURVEY: XXX(XXXXX)[/TD]
[TD="class: xl65, width: 64"][/TD]

[TD="class: xl65, width: 713, colspan: 7"](23/02/17 17:17:50 ) 17:17:41.221 - 47567895744: Stock exchange[/TD]
[TD="class: xl65, width: 64"][/TD]

[TD="class: xl65, width: 713, colspan: 7"](23/02/17 17:17:50 ) 17:17:41.222 - 1755745: EVENT -- today please visit[/TD]
[TD="class: xl65, width: 64"][/TD]

[TD="class: xl65, width: 713, colspan: 7"](23/02/17 17:17:35 ) 17:17:21.536 - 27366546059: Collection Done:SURVEY:XXXXXXX[/TD]
[TD="class: xl65, width: 64"][/TD]

[TD="colspan: 7"](23/02/17 17:17:20 ) 17:31:26.969 - 2187687604: DATA SENT:XXXXXXXXX[/TD]
[TD="class: xl65, width: 64"][/TD]

[TD="class: xl65, width: 777, colspan: 8"](23/02/17 17:17:50 ) 17:17:39.016 - 2753567789839:Speaking Clock: MON: XXXXXX[/TD]

[TD="colspan: 7"](23/02/17 17:17:35 ) 17:17:27.230 - 2771753: MON:XXXXXX[/TD]
[TD="class: xl65, width: 64"][/TD]

[TD="class: xl65, width: 777, colspan: 8"](23/02/17 17:17:50 ) 17:17:39.691 - 27589004214: EVENT -- triggered by missing the bus[/TD]

[TD="class: xl65, width: 713, colspan: 7"](23/02/17 17:17:20 ) 17:14:59.772 - 36365654395: SURVEY: XXX(XXXXX)[/TD]
[TD="class: xl65, width: 64"][/TD]

[TD="class: xl65, width: 713, colspan: 7"](23/02/17 17:17:35 ) 17:17:21.536 - 27366546059: Collection Done:SURVEY:XXXXXXX[/TD]
[TD="class: xl65, width: 64"][/TD]

</tbody>
 
Upvote 0
See if this does what you want.

Rich (BB code):
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
 
Upvote 0
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
 
Upvote 0
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
Rich (BB code):
.AutoFilter Field:=1, Criteria1:="<>*%%%*"
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top