Solved: Creating a look-up and complete macro

[Sir Babydum GBE]

Hi

I’m trying to create a course scheduling spreadsheet. To give some background: Each member of staff where I work must a) attend 1 course every two months AND b) Receive an appraisal once every two months. Not all courses are essential to all Staff. When the cycle of courses is complete then we start again provided that a given employee hasn’t quit (of course!). I say “cycle” – the courses don’t need to be done in any particular order

So I’ve attached a workbook that will form the basis of some pivot reports that will give our manager on a weekly basis an idea of who needs what training. (I haven’t done the pivots yet)

What I need help with is getting a macro to look at the “Staff” sheet and then, one member of staff at a time do the following:

Look to see if the “Fire” course is applicable to that member of staff
If it is, then look at the training record sheet to see if there is a record of fire training for that member of staff.
If not, then create a new record, filling in “Name”, “Position”, “Course” and “Done?” (with a “No”)
If there IS already a record for fire training, but there is a “No” under “Current”, then create a new record anyway as in step 3.
If there is a record for fire training, but which has a “Yes” under “Current”, then do not create a new record
Go back to the “staff” sheet and look at the next applicable course for that member of staff and repeat steps 2 to 6 until all applicable courses have been considered.
Move on to the next member of staff.I know this looks like a big ask :dunno – I’m hoping it’s a simple-ish series of loops that won’t be too complicated to write code for.

If you can help or perhaps suggest an alternative method I really would appreciate it very much

In your debt

Sir BD

[Simon Lloyd]

Firstly long time no see :)

Secondly, i have a workbook that has a single sheet set up where at a glance you can see the employees status for a given course (Skill in my case) automatically indicating if they are due that training again, it works on a per person basis and a click of a button takes you to the dates.

If you think it could work for you i'll dig it out, adjust it (after ive had a look at your workbook) and post it here.

[Sir Babydum GBE]

I have a workbook that has a single sheet set up where at a glance you can see the employees status for a given course ... if you think it could work for you i'll dig it out, adjust it (after ive had a look at your workbook) and post it here.Thanks Simon, I'd like to look at it please - I'm open to suggestions.

Our Matron (she's the boss in a Nursing Home) has quite a specific "database" in mind. With the exception of the Fire and Manual Handling courses that must be trained annually, she's not so concerned with the order of the training or, in fact, that each course is trained. Legally we have to show that our staff receive some training every 2 months.

So I'm particularly interested in creating a Pivot report that will show names of staff who are due for training along with a list of courses not already done this year that she can take her pick from.

That's the type of thing I'm after.

I can handle the different reports I need provided I can get all relevant info onto one sheet so that I can generate Pivots

[Simon Lloyd]

Well if she's that specific my original offer wouldn't do, however maybe you can make use of the attached, if there are gaps i apologise as i removed my company logo's..etc and likewise if any remain please remove them before you release it :)

The attached i used for course ordering, it has a pricing structure too but you should be able to adapt it, it's already set up for pivot charts & CSV files too!

[Bob Phillips]

Does this do it BD?



Public Sub ProcessData()
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long, j As Long
Dim sh As Worksheet
Const UPDATE_FORMULA As String = _
"MATCH(1,('Training_Record'!B2:B<nextrow>=""<staff>"")*('Training_Record'!D2:D<nextrow>=""<course>"")*('Training_Record'!E2:E<nextrow>=""Yes""),0)"

Set sh = Worksheets("Training_Record")
With Worksheets("Staff")

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 3 To LastRow

For j = 9 To 18

If .Cells(i, j).Value = "Yes" Then

NextRow = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row + 1
If IsError(Application.Evaluate(Replace(Replace(UPDATE_FORMULA, _
"<nextrow>", NextRow), _
"<staff>", .Cells(i, COL_STAFF).Value))) Then

sh.Cells(NextRow, "B").Value = .Cells(i, COL_STAFF).Value
sh.Cells(NextRow, "C").Value = .Cells(i, COL_JOB).Value
sh.Cells(NextRow, "D").Value = .Cells(2, j).Value
sh.Cells(NextRow, "E").Value = "No"
sh.Cells(NextRow, "F").Value = Date
sh.Cells(NextRow, "G").Value = "Yes"
End If
End If
Next j
Next i
End With

End Sub

[Sir Babydum GBE]

Hi Simon - Thanks very much for this - I'm gonna take a look at this, because you never know - parts of it may come in handy. Appreeciated.

XLD - Thanks very much indeed for your reply too!

At home I'm getting the debugger come up on this section:

If IsError(Application.Evaluate(Replace(Replace(UPDATE_FORMULA, _
"<nextrow>", NextRow), _
"<staff>", .Cells(i, COL_STAFF).Value))) Then

It says "application defined or object defined error"

I neglected to mention (sorry) that I'm using Excel 2000 at work

It says that in all versions of Excel I tried it in

[Bob Phillips]

Sorry, I omitted a crucial part of the code



Option Explicit

Public Enum COLUMN_NOS
COL_STAFF = 4
COL_JOB = 4
End Enum

Public Sub ProcessData()
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long, j As Long
Dim sh As Worksheet
Const UPDATE_FORMULA As String = _
"MATCH(1,('Training_Record'!B2:B<nextrow>=""<staff>"")*('Training_Record'!D2:D<nextrow>=""<course>"")*('Training_Record'!E2:E<nextrow>=""Yes""),0)"

Application.ScreenUpdating = False

Set sh = Worksheets("Training_Record")
With Worksheets("Staff")

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 3 To LastRow

For j = 9 To 18

If .Cells(i, j).Value = "Yes" Then

NextRow = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row + 1
If IsError(Application.Evaluate(Replace(Replace(UPDATE_FORMULA, _
"<nextrow>", NextRow), _
"<staff>", .Cells(i, COL_STAFF).Value))) Then

sh.Cells(NextRow, "B").Value = .Cells(i, COL_STAFF).Value
sh.Cells(NextRow, "C").Value = .Cells(i, COL_JOB).Value
sh.Cells(NextRow, "D").Value = .Cells(2, j).Value
sh.Cells(NextRow, "E").Value = "No"
sh.Cells(NextRow, "F").Value = Date
sh.Cells(NextRow, "G").Value = "Yes"
End If
End If
Next j
Next i
End With
Application.ScreenUpdating = True

End Sub

[Sir Babydum GBE]

Almost perfect Mr X! Thank you so much!

I say "almost" because where there is a "Yes" under the "Current" column on the Training_Record sheet then I do not need a new record created. When i test the macro it creates new records irrespective of whether there is a "Yes" or not.

I don't understand what's happening in the code so I can't tinker with it...

Well I tried but failed. :mkay

[Bob Phillips]

I think I checked the wrong column Mr BD. Just change

"MATCH(1,('Training_Record'!B2:B<nextrow>=""<staff>"")*('Training_Record'!D2:D<nextrow>=""<course>"")*('Training_Record'!E2:E<nextrow>=""Yes""),0)"


to


"MATCH(1,('Training_Record'!B2:B<nextrow>=""<staff>"")*('Training_Record'!D2:D<nextrow>=""<course>"")*('Training_Record'!G2:G<nextrow>=""Yes""),0)"

[Bob Phillips]

I meant to add a sort at the end which I forgot, so if you wanted it sortred on name just throw in



sh.Range("B2:H2").Resize(NextRow).Sort key1:=sh.Range("B2"), order1:=xlAscending, header:=xlYes


before resetting screenupdating.

[Sir Babydum GBE]

The sorting works great - which is a nice touch I hadn't thought of - thanks

The macro is still creating records when there is a "yes" in the column - even though I changed the code as directed. Hmmm :dunno

[Bob Phillips]

I missed a condition in the test



Option Explicit

Public Enum COLUMN_NOS
COL_STAFF = 4
COL_JOB = 6
End Enum

Public Sub ProcessData()
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long, j As Long
Dim sh As Worksheet
Const UPDATE_FORMULA As String = _
"MATCH(1,('Training_Record'!B2:B<nextrow>=""<staff>"")" & _
"*('Training_Record'!D2:D<nextrow>=""<course>"")" & _
"*('Training_Record'!G2:G<nextrow>=""Yes""),0)"

Application.ScreenUpdating = False

Set sh = Worksheets("Training_Record")
With Worksheets("Staff")

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
NextRow = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row
For i = 3 To LastRow

For j = 9 To 18

If .Cells(i, j).Value = "Yes" Then

If IsError(Application.Evaluate(Replace(Replace(Replace(UPDATE_FORMULA, _
"<nextrow>", NextRow), _
"<course>", .Cells(2, j).Value), _
"<staff>", .Cells(i, COL_STAFF).Value))) Then
NextRow = NextRow + 1
sh.Cells(NextRow, "B").Value = .Cells(i, COL_STAFF).Value
sh.Cells(NextRow, "C").Value = .Cells(i, COL_JOB).Value
sh.Cells(NextRow, "D").Value = .Cells(2, j).Value
sh.Cells(NextRow, "E").Value = "No"
sh.Cells(NextRow, "F").Value = Date
sh.Cells(NextRow, "G").Value = "Yes"
End If
End If
Next j
Next i
End With
sh.Range("B2:H2").Resize(NextRow).Sort key1:=sh.Range("B2"), order1:=xlAscending, header:=xlYes

Application.ScreenUpdating = True

End Sub

[Sir Babydum GBE]

I missed a condition in the test

I never would have got it. It works perfectly! I owe you a pint or 10!

:bow:

Sir BD