Can anyone help with a script?

E

Excellis

New Member
Joined
Oct 30, 2012
Messages
25
Office Version
  1. 2016
Platform
  1. Windows
Hi All
I'm just wondering if anyone could write a script for me to carry out a mundane task that tbh contains too many records to handle manually.
I am able to record macros and make simple edits but this is beyond my ken.
Ideally what I would like is to completely delete lines that fit certain criteria, or, if that can't be done, delete the contents so I can sort the rows with the blank ones at the end.
Attached is a very small sample which I believe contains all the scenarios that can and do occur.
The data is anonymised but in essence what I have is:
An extract from a LMS
2 types of vehicle a front loader & a side-saddle
2 types of training, novice & refresher, operators do a novice once followed after 3 years by a refresher and further refreshers thereafter
2 levels of operators, managers & colleagues
In the mini sheet I've indicated what action, in the sample, I need to happen.
The rules are:
Anyone with a Manager Status - delete the line
Any colleague that has completed a novice and a refresher, keep the refresher and delete the novice line
Any colleague that has completed a novice but hasn't yet completed a refresher (there will be no record for the refresher) keep the novice line
Any colleague that was supposed to complete a novice but didn't, delete the novice line
Regarding the coloured cells in pink, this is not the same colleague, it's a common name and there are 2 occurrences. They're distinguished by their clock number
In yellow, this IS the same colleague but he is proficient in both vehicles.
I'm unable to influence any of the data in the LMS so I have to work with this information.
I would also like the script to be portable across iterations of the report so if it could be run in the 'local window' (can't remember what it's officially called) that would be great.

I'm sure there will be further questions which I'm happy to answer.
Thank you in anticipation
Tom


Extract_File.xlsx
ABCDEFGHIJKL
1First NameLast NameClock NumberLevel/GradeCourse CodeLesson CodeLesson TitleExpiry dateLesson Completed DateDays out of dateAction required from the script
2JohnBates5500212ManagerB7-Front Loader54321B7-Front Loader Novice10/10/2019824DELETE - Due to Manager Status
3JohnBates5500212ManagerB7-Front LoaderB7FLRefB7-Front Loader Refresher9/10/202210/10/2019-271DELETE - Due to Manager Status
4MichaelBerrisford5500230Customer AssistantB7-Front Loader54321B7-Front Loader Novice16/11/20181152DELETE - Due to colleague has a refresher
5MichaelBerrisford5500230Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher15/11/202116/11/201857KEEP
6PeterClark5500248ManagerB7-Front LoaderB7FLRefB7-Front Loader Refresher8/04/20229/04/2019-87DELETE - Due to Manager Status
7SallyFluen5500257ManagerB7-Front Loader54321B7-Front Loader Novice18/06/2020572DELETE - Due to Manager Status
8SallyFluen5500257ManagerB7-Front LoaderB7FLRefB7-Front Loader Refresher18/06/202318/06/2020-523DELETE - Due to Manager Status
9JennySendi5500311Customer AssistantC17-Side Saddle678910C17-Side Saddle Novice9/07/2021186DELETE - Due to colleague has a refresher
10JennySendi5500311Customer AssistantC17-Side SaddleC17SSRefC17-Side Saddle Refresher8/07/20249/07/2021-909KEEP
11GeorgeFitzpatrick5500365Customer AssistantB7-Front Loader54321B7-Front Loader NoviceDELETE - Colleague did not complete his Novice (Col I is blank)
12MichaelEdwards5500392Customer AssistantC17-Side Saddle678910C17-Side Saddle Novice17/06/202418/06/2021207KEEP - Colleague has not needed to do a refresher
13WendyCarruthers5500401Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher10/11/202211/11/2019-303KEEP
14JohnBrown5500410Customer AssistantB7-Front Loader54321B7-Front Loader Novice22/10/202181DELETE - Due to colleague has a refresher
15JohnBrown5500410Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher21/10/202422/10/2021-1014KEEP
16BrianReilly5500428ManagerC17-Side SaddleC17SSRefC17-Side Saddle Refresher30/09/20241/10/2021-993DELETE - Due to Manager Status
17AdamFothergill5500437Customer AssistantB7-Front Loader54321B7-Front Loader Novice23/04/2020628DELETE - Due to colleague has a refresher
18AdamFothergill5500437Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher23/04/202323/04/2020-467KEEP
19JohnBrown5500455Customer AssistantB7-Front Loader54321B7-Front Loader Novice23/09/2020475DELETE - Due to colleague has a refresher
20JohnBrown5500455Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher23/09/202323/09/2020-620KEEP
21PaulClements5500473Customer AssistantB7-Front Loader54321B7-Front Loader Novice18/02/2021327DELETE - Due to colleague has a refresher
22PaulClements5500473Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher18/02/202418/02/2021-768KEEP
23MaryEvans5500491Customer AssistantB7-Front Loader54321B7-Front Loader Novice30/10/2020438DELETE - Due to colleague has a refresher
24MaryEvans5500491Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher30/10/202330/10/2020-657KEEP
25SamEwing5500509Customer AssistantB7-Front Loader54321B7-Front Loader NoviceDELETE - Colleague did not complete his Novice (Col I is blank)
26JohnJefferies5510201Customer AssistantB7-Front Loader54321B7-Front Loader Novice18/06/2020572DELETE - Due to colleague has a refresher
27JohnJefferies5510201Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher18/06/202318/06/2020-523KEEP
28JohnJefferies5510201Customer AssistantC17-Side Saddle678910C17-Side Saddle Novice9/07/2021186DELETE - Due to colleague has a refresher
29JohnJefferies5510201Customer AssistantC17-Side SaddleC17SSRefC17-Side Saddle Refresher8/07/20249/07/2021-909KEEP
30
31I WANT TO BE LEFT WITH:
32MichaelBerrisford5500230Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher15/11/202116/11/201857
33JennySendi5500311Customer AssistantC17-Side SaddleC17SSRefC17-Side Saddle Refresher8/07/20249/07/2021-909
34MichaelEdwards5500392Customer AssistantC17-Side Saddle678910C17-Side Saddle Novice17/06/202418/06/2021207
35WendyCarruthers5500401Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher10/11/202211/11/2019-303
36JohnBrown5500410Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher21/10/202422/10/2021-1014
37AdamFothergill5500437Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher23/04/202323/04/2020-467
38JohnBrown5500455Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher23/09/202323/09/2020-620
39PaulClements5500473Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher18/02/202418/02/2021-768
40MaryEvans5500491Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher30/10/202330/10/2020-657
41JohnJefferies5510201Customer AssistantB7-Front LoaderB7FLRefB7-Front Loader Refresher18/06/202318/06/2020-523
42JohnJefferies5510201Customer AssistantC17-Side SaddleC17SSRefC17-Side Saddle Refresher8/07/20249/07/2021-909
Extract
 
Sort by date Sort by votes
Sorry. I'm home now. I just gave you the Sub only. You still need to use the Function in the earlier post as well.

This part may be missing
VBA Code: 
Function MarkDelete(c As Range, rng As Range) As Range
If rng Is Nothing Then Set MarkDelete = c Else Set MarkDelete = Union(rng, c)
End Function
 
Upvote 0

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Thanks for your patience and persistence, Zot. I'm sure I'm making this far more complicated than it needs to be.
I've put the bits together as I think they should go and it does seem to work, but only one line at a time.
Here's the macro I'm running. Any advice?

Sub Test()

Dim cell As Range, rngData As Range, rngDelete As Range
Dim ws As Worksheet

Set ws = ActiveWorkbook.Sheets("Expired") ' Change sheet name here if required
Set rngData = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngData
If ws.Range("G" & cell.Row) Like "*Manager*" Then Set rngDelete = MarkDelete(cell, rngDelete)
If ws.Range("K" & cell.Row) = "" Then Set rngDelete = MarkDelete(cell, rngDelete)
Next
rngDelete.EntireRow.Delete

End Sub

Function MarkDelete(c As Range, rng As Range) As Range
If rng Is Nothing Then Set MarkDelete = c Else Set MarkDelete = Union(rng, c)
End Function
 
Upvote 0
I don't know how your working sheet looks like. Your previous sample was column D for Level/Grade where you have keywords Manager to look for and column H for blanks. Now you changed your code to G and K.. So, I have no idea what you meant by but only one line at a time. Looks like the table has changed.

Can you post example of your working sheet?
 
Upvote 0
Zot said:
I don't know how your working sheet looks like. Your previous sample was column D for Level/Grade where you have keywords Manager to look for and column H for blanks. Now you changed your code to G and K.. So, I have no idea what you meant by but only one line at a time. Looks like the table has changed.

Can you post example of your working sheet?
Click to expand...
Sorry Zot
I was trying to anonymise commercial and personal sensitive data.
Here's an extract without any structure changes, I've just kept the essential information for you.


0._Safe_and_Legal_FLT_Report_11.01.2022.xlsm
BCDEFGHIJKLMNO
1First NameLast NameClock No.StoreRegionJob TitleCourse CodeLesson CodeLesson TitleExpiry dateCompletion DateRefresher RequiredValid LicenceDays out of date
2xxxxxxxxxxxxxxxxxxxxx1XXXXXXXNight Manager - 4/7xxxxxxxxxxxxxxxxxxxxx9/10/202210/10/2019In Date-271
3xxxxxxxxxxxxxxxxxxxxx2XXXXXXXCustomer Assistant - Fruit & Vegxxxxxxxxxxxxxxxxxxxxx16/11/20181152
4xxxxxxxxxxxxxxxxxxxxx3XXXXXXXCustomer Assistant - Fruit & Vegxxxxxxxxxxxxxxxxxxxxx15/11/202116/11/2018Refresher Required57
5xxxxxxxxxxxxxxxxxxxxx4XXXXXXXNight Manager - 4/7xxxxxxxxxxxxxxxxxxxxx8/04/20229/04/2019In Date-87
6xxxxxxxxxxxxxxxxxxxxx5XXXXXXXNight Manager - 4/7xxxxxxxxxxxxxxxxxxxxx25/09/202126/09/2018Refresher Required108
7xxxxxxxxxxxxxxxxxxxxx6XXXXXXXFresh Food Managerxxxxxxxxxxxxxxxxxxxxx18/06/2020572
8xxxxxxxxxxxxxxxxxxxxx7XXXXXXXFresh Food Managerxxxxxxxxxxxxxxxxxxxxx18/06/202318/06/2020In Date-523
9xxxxxxxxxxxxxxxxxxxxx8XXXXXXXNight Manager - 4/7xxxxxxxxxxxxxxxxxxxxx3/11/20224/11/2019In Date-296
10xxxxxxxxxxxxxxxxxxxxx9XXXXXXXNight Manager - 4/7xxxxxxxxxxxxxxxxxxxxx17/02/202218/02/2019In Date-37
11xxxxxxxxxxxxxxxxxxxxx10XXXXXXXMarket Street Manager - Countersxxxxxxxxxxxxxxxxxxxxx13/04/20181369
12xxxxxxxxxxxxxxxxxxxxx11XXXXXXXMarket Street Manager - Countersxxxxxxxxxxxxxxxxxxxxx9/04/202110/04/2018Refresher Required277
13xxxxxxxxxxxxxxxxxxxxx12XXXXXXXNight Customer Assistant - Groceryxxxxxxxxxxxxxxxxxxxxx9/07/2021186
14xxxxxxxxxxxxxxxxxxxxx13XXXXXXXNight Customer Assistant - Groceryxxxxxxxxxxxxxxxxxxxxx8/07/20249/07/2021In Date-909
15xxxxxxxxxxxxxxxxxxxxx14XXXXXXXFresh Food Managerxxxxxxxxxxxxxxxxxxxxx22/04/2020629
16xxxxxxxxxxxxxxxxxxxxx15XXXXXXXFresh Food Managerxxxxxxxxxxxxxxxxxxxxx22/04/202322/04/2020In Date-466
17xxxxxxxxxxxxxxxxxxxxx16XXXXXXXCustomer Assistant - Groceryxxxxxxxxxxxxxxxxxxxxx15/03/20162128
18xxxxxxxxxxxxxxxxxxxxx17XXXXXXXCustomer Assistant - Groceryxxxxxxxxxxxxxxxxxxxxx13/03/202214/03/2019In Date-61
19xxxxxxxxxxxxxxxxxxxxx18XXXXXXXNight Customer Assistant - Groceryxxxxxxxxxxxxxxxxxxxxx
20xxxxxxxxxxxxxxxxxxxxx19XXXXXXXNight Manager - 4/7xxxxxxxxxxxxxxxxxxxxx8/11/20161890
21xxxxxxxxxxxxxxxxxxxxx20XXXXXXXNight Manager - 4/7xxxxxxxxxxxxxxxxxxxxx8/11/20198/11/2016Refresher Required795
22xxxxxxxxxxxxxxxxxxxxx21XXXXXXXCustomer Assistant - Delixxxxxxxxxxxxxxxxxxxxx18/06/2021207
23xxxxxxxxxxxxxxxxxxxxx22XXXXXXXCustomer Assistant - Delixxxxxxxxxxxxxxxxxxxxx17/06/202418/06/2021In Date-888
24xxxxxxxxxxxxxxxxxxxxx23XXXXXXXCustomer Assistant - Fruit & Vegxxxxxxxxxxxxxxxxxxxxx10/11/202211/11/2019In Date-303
25xxxxxxxxxxxxxxxxxxxxx24XXXXXXXCustomer Assistant - Freshxxxxxxxxxxxxxxxxxxxxx22/10/202181
26xxxxxxxxxxxxxxxxxxxxx25XXXXXXXCustomer Assistant - Freshxxxxxxxxxxxxxxxxxxxxx21/10/202422/10/2021In Date-1014
27xxxxxxxxxxxxxxxxxxxxx26XXXXXXXReplenishment Managerxxxxxxxxxxxxxxxxxxxxx30/09/20241/10/2021In Date-993
28xxxxxxxxxxxxxxxxxxxxx27XXXXXXXCustomer Assistant - Car Parkxxxxxxxxxxxxxxxxxxxxx23/04/2020628
Expired
 
Upvote 0
Looks like the table column shifted to the right. The line
Set rngData = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
is used to capture the data range starting from A2 to last row of column A in sample data.

Now column A is empty. So, need to gauge column B which will need to change the line to
Set rngData = ws.Range("B2", ws.Cells(Rows.Count, "B").End(xlUp))

This will solve the problem
 
Upvote 0
Zot, that works perfectly. Thank you so much and apologies for all the confusion I caused by trying to be 'clever'.
Do we still give Kudos on this site? And if so, how?
 
Upvote 0
Excellis said:
Zot, that works perfectly. Thank you so much and apologies for all the confusion I caused by trying to be 'clever'.
Do we still give Kudos on this site? And if so, how?
Click to expand...
Glad could help until the end. There should be Mark as solution. Refer
www.mrexcel.com

Mark as Solution

The helpers at the MrExcel community enjoy providing answers to your Excel questions, but we need to know that we're actually helping you. To aid in this, we decided to use the new 'Mark as solution' functionality. This allows the Original Poster (OP) of a thread to mark the solution post...
www.mrexcel.com www.mrexcel.com
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Excel Formula to highlight most recent record
Replies
3
Views
90
etaf
etaf
nburaq
  • Solved
Calculate interval between dates based on input at another columns
Replies
2
Views
124
awoohaw
awoohaw
M
  • Question
Best solution to consolidate values that occur on multiple dates/lines
Replies
5
Views
263
Peter_SSs
Peter_SSs
G
  • Question
Help me with this!
Replies
1
Views
171
bobaol
B
C
  • Solved
Extract Dates from 2 columns
Replies
2
Views
300
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,551
Messages
6,120,161
Members
448,948
Latest member
spamiki

Share this page

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