Hi pog_g,
See this macro code if this helps.
Sub Auto_Open()
' If StartDay is blank, enter this Monday
Dim tday
tday = Now
Worksheets("TimeSheet").Activate
Set startday = Sheets("TimeSheet").Range("StartDay")
If IsEmpty(startday) Then
startday.Value = tday
Do Until Weekday(startday) = 7
startday.Value = startday.Value - 1
Loop
End If
End Sub
Sub Clear()
ActiveSheet.Unprotect
Range("Timedata").ClearContents
ActiveSheet.Protect _
End Sub
Sub NextWeek()
Set startday = Sheets("TimeSheet").Range("StartDay")
startday.Value = startday + 7
Do Until Weekday(startday) = 7
startday.Value = startday.Value - 1
Loop
End Sub
Sub LastWeek()
Set startday = Sheets("TimeSheet").Range("StartDay")
startday.Value = startday - 7
Do Until Weekday(startday) = 7
startday.Value = startday.Value - 1
Loop
End Sub
Sub Clsa()
ActiveSheet.Unprotect
If Range("G15").Interior.Pattern = xlSolid Then
Range("G15:G39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlGray8
.PatternColorIndex = xlAutomatic
End With
ElseIf Range("G15").Interior.Pattern = xlGray8 Then
Range("G15:G39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
ActiveSheet.Protect
Range("B6").Select
End Sub
Sub Clsu()
ActiveSheet.Unprotect
If Range("H15").Interior.Pattern = xlSolid Then
Range("H15:H39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlGray8
.PatternColorIndex = xlAutomatic
End With
ElseIf Range("H15").Interior.Pattern = xlGray8 Then
Range("H15:H39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
ActiveSheet.Protect
Range("B6").Select
End Sub
Sub shade1()
ActiveSheet.Unprotect
If Range("I15").Interior.Pattern = xlSolid Then
Range("I15:I39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlGray8
.PatternColorIndex = xlAutomatic
End With
ElseIf Range("I15").Interior.Pattern = xlGray8 Then
Range("I15:I39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
ActiveSheet.Protect
Range("B6").Select
End Sub
Sub shade2()
ActiveSheet.Unprotect
If Range("J15").Interior.Pattern = xlSolid Then
Range("J15:J39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlGray8
.PatternColorIndex = xlAutomatic
End With
ElseIf Range("J15").Interior.Pattern = xlGray8 Then
Range("J15:J39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
ActiveSheet.Protect
Range("B6").Select
End Sub
Sub shade3()
ActiveSheet.Unprotect
If Range("K15").Interior.Pattern = xlSolid Then
Range("K15:K39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlGray8
.PatternColorIndex = xlAutomatic
End With
ElseIf Range("K15").Interior.Pattern = xlGray8 Then
Range("K15:K39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
ActiveSheet.Protect
Range("B6").Select
End Sub
Sub shade4()
ActiveSheet.Unprotect
If Range("L15").Interior.Pattern = xlSolid Then
Range("L15:L39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlGray8
.PatternColorIndex = xlAutomatic
End With
ElseIf Range("L15").Interior.Pattern = xlGray8 Then
Range("L15:L39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
ActiveSheet.Protect
Range("B6").Select
End Sub
Sub shade5()
ActiveSheet.Unprotect
If Range("M15").Interior.Pattern = xlSolid Then
Range("M15:M39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlGray8
.PatternColorIndex = xlAutomatic
End With
ElseIf Range("M15").Interior.Pattern = xlGray8 Then
Range("M15:M39").Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
ActiveSheet.Protect
Range("B6").Select
End Sub
Sub newsh()
Dim shtName As String
Dim ref
Dim wSht As Worksheet
Set ref = Sheets("TimeSheet").Range("EndDay")
shtName = Format(ref, "ddmmmyy")
For Each wSht In Worksheets
If wSht.Name = shtName Then
MsgBox "Sorry! This sheet already exists."
Exit Sub
End If
Next wSht
Sheets.Add.Name = shtName
Sheets(shtName).Move Befo=Sheets(Sheets.Count)
Sheets("TimeSheet").Range("A13:N42").Copy Sheets(shtName).Range("A1")
Sheets("TimeSheet").Range("G14:M14").Copy
Sheets(shtName).Select
Range("G2:M2").Select
Selection.PasteSpecial Paste:=xlPasteValues
Cells.Select
Cells.EntireColumn.AutoFit
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Range("A1").Select
End Sub
"pog_g" wrote:
I've created a spreadsheet to record timecard hours and am now trying to
create another sheet or entire workbook that extracts this information.
I have inserted Sheet1 as an example of how I want this information to
come out and would only want the entries of when the people actually
worked (i.e. no blank entries).
The problem is that these spreadsheets are used each fortnight and the
information varies as each staff members hours and duties vary so the
formula/code would need to be a lot more dynamic than I am/know how
to.
I know this could be a major thing but if anyone could help me or at
least point me in the right direction, it would be most appreciated.
Cheers
+-------------------------------------------------------------------+
|Filename: Staff Pays.zip |
|Download: http://www.excelforum.com/attachment.php?postid=3869 |
+-------------------------------------------------------------------+
--
pog_g
------------------------------------------------------------------------
pog_g's Profile: http://www.excelforum.com/member.php...o&userid=27683
View this thread: http://www.excelforum.com/showthread...hreadid=472015