Track employees location on schedule in Excel

Track employees location on schedule in Excel, Schedule locations for staff. Make sure that all locations are covered. Track many employees for many locations VBA code included. employee are listed in the locations. Track how often equipment was used
Code for schedule
Sub autoshift()
Dim i, sat As Integer
Dim startpos As Range
Dim y As Integer
Dim rng As Range
Dim findstring As String
i = 4

For i = 5 To 49
If (i = 5 Or i = 10 Or i = 15 Or i = 20) Then
y = 3
Sheet1.Cells(i, y).Select
For y = 3 To 6
ActiveCell.Value = "O"
ActiveCell.Offset(0, 1).Value = "O"
ActiveCell.Offset(0, 2).Value = "O"
ActiveCell.Offset(0, 7).Select
Next y
End If
If (i = 6 Or i = 11 Or i = 16) Then
y = 4
Sheet1.Cells(i, y).Select
For y = 4 To 7
ActiveCell.Value = "O"
ActiveCell.Offset(0, 1).Value = "O"
ActiveCell.Offset(0, 2).Value = "O"
ActiveCell.Offset(0, 7).Select
Next y
End If
If (i = 7 Or i = 12 Or i = 17) Then
y = 5
Sheet1.Cells(i, y).Select
For y = 5 To 8
ActiveCell.Value = "O"
ActiveCell.Offset(0, 1).Value = "O"
ActiveCell.Offset(0, 2).Value = "O"
ActiveCell.Offset(0, 7).Select
Next y
End If
If (i = 8 Or i = 13 Or i = 18) Then
y = 6
Sheet1.Cells(i, y).Select
For y = 6 To 9
ActiveCell.Value = "O"
ActiveCell.Offset(0, 1).Value = "O"
ActiveCell.Offset(0, 2).Value = "O"
ActiveCell.Offset(0, 7).Select
Next y
End If
If (i = 9 Or i = 14 Or i = 19) Then
y = 7
Sheet1.Cells(i, y).Select
For y = 7 To 10
ActiveCell.Value = "O"
ActiveCell.Offset(0, 1).Value = "O"
ActiveCell.Offset(0, 2).Value = "O"
ActiveCell.Offset(0, 7).Select
Next y
End If


Next i
'Range("c4:AG48").Replace What:="", Replacement:="W"
End Sub
Code for locations
Sub transferroutes()
Dim i As Integer
Dim y As Integer
Dim routen As String
Dim findrng As Range
Dim searccolum As Integer
Dim X As Long
X = 5
Worksheets("locations").Activate
routen = Worksheets("locations").Cells(X, 1).Value
' while there are still route numbers do
Do While routen (does not equal) "end"
y = 3
routen = Worksheets("locations").Cells(X, 1).Value
'select the first day
Worksheets("sheet1").Select
searccolum = 3
For searccolum = 3 To 30
Set findrng = Sheet1.Columns(searccolum).Find(What:=routen, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If findrng Is Nothing Then
Worksheets("locations").Cells(X, y).Value = "E"
GoTo ende
Else
rownumber = findrng.Row
Worksheets("locations").Cells(X, y).Value = Worksheets("sheet1").Cells(rownumber, 2)
End If

ende:
y = y + 1
Next searccolum
Worksheets("locations").Activate
X = X + 1
Loop
Worksheets("locations").Activate
End Sub
For more help visit my website www.easyexcelan... or email me at [e-mail].
Contact me regarding customizing this template for your needs.
Excel one-on-one on-line training available. Email me to arrange.
I am able to provide online help on your computer at a reasonable rate.
Check out my next one-hour Excel Webinar
www.crowdcast....
I use a Blue condensor Microphone to record my videos, here is the link
amzn.to/37gyyGa
Check out Crowdcast for creating your webinars
app.linkmink.c...
If you need to buy Office 2019 follow
amzn.to/2VX5dv8
Follow me on Facebook
/ easyexcel.answers
Follow me on twitter
easyexcelanswers
IG @barbhendersonconsulting
You can help and generate a translation to you own language
www.youtube.com...
*this description may contain affiliate links. When you click them, I may receive a small commission at no extra cost to you. I only recommend products and services that I've used or have experience with.

[@BarbHendersonconsulting]

Thanks so much for watching! Let me know in the comments if this is going to work for you.

[@hosangi.t.2508]

Thank you for taking the time to share this great spreadsheet. It almost fit what we were looking for. In our case we have some employees (colors) covering a location on location and another location remotely and I don't believe this would be able to cover two locations with an employee marked -p physical and -r for remote or something like that. Will have to keep playing.. thanks again.

[@BarbHendersonconsulting]

Glad it was helpful!