How to?: Daily printout of unstaffed shifts

aris123

New Member
Joined
Mar 2, 2018
Messages
1
Hi all
I have a table, pasted below, which shows the daily cover status for different areas at work.

I need a way (perhaps VBA) to automatically print / generate a table showing:

1) Today only
2) Listing the ones without cover in the AM
3) Listing the ones without cover in the PM
(examples two bottom tables)

Any help is greatly appreciated. Many thanks in advance


A1BCDEFGHIJKL
2blaMONDAYTUESDAYWEDNESDAYTHURSDAYFRIDAY
3Week Commencing: 05/03/1805/03/201806/03/201807/03/201808/03/201809/03/2018
4aaArea APerson1 AMno Coverno CoverCoverno Coverno Cover
5Person1 PMCoverCoverCoverCoverno Cover
6person2 AM
7person2 PM
8abArea BPerson1 AMno CoverCoverno CoverCoverno Cover
9Person1 PMno Coverno Coverno CoverCoverCover
10person2 AM
11person2 PM
12
13
14
15
16Areas with no cover – Date: 05/03/2018
17AMArea A, Area B
18PMArea B
19
20
21Areas with no cover – Date: 06/03/2018
22AMArea A
23PMArea B

<tbody>
</tbody>
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
cleanup the rota to look like:

Week Commencing: 05/03/18MONDAYTUESDAYWEDNESDAYTHURSDAYFRIDAY
areashiftname5/3/20186/3/20187/3/20188/3/20189/3/2018
area AAMperson1no Coverno CoverCoverno CoverCover
AMperson2Cover
PMperson1Cover
PMperson2Cover
area BAMperson1no Coverno CoverCoverno CoverCover
AMperson2no Cover
PMperson1
PMperson2

<tbody>
</tbody>

then run this code:

Code:
Sub aMacro1()
Dim c As Integer
Dim vDate, vArea, vShift, vCovrd
Dim colDtes As New Collection, colBad As New Collection
Dim sDteSh As String
Dim itm


On Error GoTo ErrAdd
Range("C2").Select
For c = 1 To 5
  colDtes.Add ActiveCell.Offset(0, c).Value
Next


Range("C3").Select   'start at 1st person
While ActiveCell.Value <> ""
    vShift = ActiveCell.Offset(0, -1).Value
    GoSub getArea
    
    For c = 1 To 5   'check @ day of week
        vDate = colDtes(c)
        vCovrd = ActiveCell.Offset(0, c).Value
        If InStr(LCase(vCovrd), "no") > 0 Then            
            colBad.Add vDate & ":" & vShift & ":" & vArea
           'Debug.Print vDate & ":" & vShift & ":" & vArea
        End If
    Next
    
   ActiveCell.Offset(1, 0).Select  'next row
Wend


Sheets.Add
For Each itm In colBad
   ActiveCell.Value = itm
   ActiveCell.Offset(1, 0).Select    'next row
Next


Set colDtes = Nothing
Set colBad = Nothing
Exit Sub


getArea:
  If ActiveCell.Offset(0, -2).Value <> "" Then vArea = ActiveCell.Offset(0, -2).Value
Return


Exit Sub
ErrAdd:
If Err = 457 Then
  Resume Next
Else
MsgBox Err.Description, , Err
End If
Resume Next
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,213
Members
448,554
Latest member
Gleisner2

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