How to?: Daily printout of unstaffed shifts

A

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


[TABLE="width: 949"]
<tbody>[TR]
[TD]A1[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]bla[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]MONDAY[/TD]
[TD]TUESDAY[/TD]
[TD]WEDNESDAY[/TD]
[TD]THURSDAY[/TD]
[TD]FRIDAY[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD="colspan: 3"]Week Commencing: 05/03/18[/TD]
[TD][/TD]
[TD]05/03/2018[/TD]
[TD]06/03/2018[/TD]
[TD]07/03/2018[/TD]
[TD]08/03/2018[/TD]
[TD]09/03/2018[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]aa[/TD]
[TD="colspan: 3"]Area A[/TD]
[TD]Person1 AM[/TD]
[TD]no Cover[/TD]
[TD]no Cover[/TD]
[TD]Cover[/TD]
[TD]no Cover[/TD]
[TD]no Cover[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Person1 PM[/TD]
[TD]Cover[/TD]
[TD]Cover[/TD]
[TD]Cover[/TD]
[TD]Cover[/TD]
[TD]no Cover[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]person2 AM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]person2 PM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]ab[/TD]
[TD="colspan: 3"]Area B[/TD]
[TD]Person1 AM[/TD]
[TD]no Cover[/TD]
[TD]Cover[/TD]
[TD]no Cover[/TD]
[TD]Cover[/TD]
[TD]no Cover[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]Person1 PM[/TD]
[TD]no Cover[/TD]
[TD]no Cover[/TD]
[TD]no Cover[/TD]
[TD]Cover[/TD]
[TD]Cover[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]person2 AM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]person2 PM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD="colspan: 5"]Areas with no cover – Date: 05/03/2018[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]AM[/TD]
[TD="colspan: 4"]Area A, Area B[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]18[/TD]
[TD]PM[/TD]
[TD="colspan: 4"]Area B[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]19[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]20[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]21[/TD]
[TD="colspan: 5"]Areas with no cover – Date: 06/03/2018[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]22[/TD]
[TD]AM[/TD]
[TD="colspan: 4"]Area A[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]23[/TD]
[TD]PM[/TD]
[TD="colspan: 4"]Area B[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
cleanup the rota to look like:

[TABLE="width: 781"]
<tbody>[TR]
[TD]Week Commencing: 05/03/18[/TD]
[TD][/TD]
[TD][/TD]
[TD]MONDAY[/TD]
[TD]TUESDAY[/TD]
[TD]WEDNESDAY[/TD]
[TD]THURSDAY[/TD]
[TD]FRIDAY[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]area[/TD]
[TD]shift[/TD]
[TD]name[/TD]
[TD="align: right"]5/3/2018[/TD]
[TD="align: right"]6/3/2018[/TD]
[TD="align: right"]7/3/2018[/TD]
[TD="align: right"]8/3/2018[/TD]
[TD="align: right"]9/3/2018[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]area A[/TD]
[TD]AM[/TD]
[TD]person1[/TD]
[TD]no Cover[/TD]
[TD]no Cover[/TD]
[TD]Cover[/TD]
[TD]no Cover[/TD]
[TD]Cover[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]AM[/TD]
[TD]person2[/TD]
[TD]Cover[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]PM[/TD]
[TD]person1[/TD]
[TD][/TD]
[TD]Cover[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]PM[/TD]
[TD]person2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Cover[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]area B[/TD]
[TD]AM[/TD]
[TD]person1[/TD]
[TD]no Cover[/TD]
[TD]no Cover[/TD]
[TD]Cover[/TD]
[TD]no Cover[/TD]
[TD]Cover[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]AM[/TD]
[TD]person2[/TD]
[TD]no Cover[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]PM[/TD]
[TD]person1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]PM[/TD]
[TD]person2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

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
You must log in or register to reply here.

Similar threads

R
  • Solved
Need help figuring out how to move/combine data over.
Replies
6
Views
235
alansidman
A
R
  • Solved
vlookup, INDEX, or SUMPRODUCT???
2
Replies
10
Views
834
KRice
K
J
  • Solved
Sorting a Lot of data into multiple sheets (up to 200k lines)
Replies
4
Views
335
JMWh1t3
J
Z
  • Question Question
Excel Formula for Client Availability Sheet
Replies
2
Views
183
Zee996
Z
U
  • Question Question
Chart creation - best presentation?
Replies
2
Views
443
Fluff
Fluff

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

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