Hi all, i have created a problem for myself, i have 3 named range
hols1,2 and 3 which covers everyones holidays, in order for anothe
date to be entered the user enters a new date in spare cells below th
ranges and the persons name, when the program is closed it sorts al
the cells over a numbered range in date order.......my problem i
this...............when it sorts and you re open the program the range
havent expanded when the new rows have been sorted in to place and it
throwing all my figures out below is my code....all of it but it woul
be better if you could see the workbook and what im trying t
achieve...can you help?

Simon

Sub auto_close()

Sheets("Holidays").Select
ActiveSheet.Unprotect
EnableEvents = False
With Application
.EnableEvents = False
.Calculation = xlManual
.MaxChange = 0.001
.CalculateBeforeSave = False
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Range("A14:AK545").Select
Selection.sort Key1:=Range("A14"), Order1:=xlAscending
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
_
DataOption1:=xlSortNormal
Range("a1").Select
Application.DisplayAlerts = False
Application.DisplayFormulaBar = True
ActiveCell = xlNone

With Application
.Calculation = xlAutomatic
End With
ActiveSheet.Protect

ActiveWorkbook.Save
End Sub


Sub Auto_open()

Dim t1 As String
Dim I1 As Integer
Dim I2 As Integer
Application.DisplayAlerts = False
Application.DisplayFormulaBar = False
Sheets("logged").Visible = False
Range("A1").Select
ActiveCell = xlNone
With Application
.EnableEvents = True
.Calculation = xlAutomatic
.MaxChange = 0.001
End With


For I2 = 1 To 3
t1 = InputBox("Enter Your GBK Login", "Login Verification"
"")
If t1 = "gbksxl04" Or t1 = "gbkdxb02" Or t1 = "gbkmxg04" Or t
= "gbkaxp02" Or t1 = "gbkbxs03" Or t1 = "gbkhxb03" Or t1 = "gbksxh03
Or t1 = "gbktah01" Then
ActiveCell = t1
Call startup

Exit Sub
Else
Worksheets("gbk track").Visible = True
Worksheets("gbk track").Select
ActiveSheet.Range("a2").Select
Selection.EntireRow.Insert Shift:=xlDown
Selection = t1 & " " & Now
Worksheets("gbk track").Visible = False
End If
Next 'I2
'MsgBox "Buzz Off " & t1
MsgBox "Please Contact Your Shift Manager " & Chr(13) & "The Entry
" & t1 & " not recognised"

ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub

Sub dateselect()
Dim mycell
Dim todaydate As Range
Dim rng As Range
Dim offset
Set rng = Range("todaydate")
For Each mycell In rng

If mycell.Value = Date Then
mycell.Select
MsgBox "Today is " & ActiveCell.Value
Exit Sub
End If
Next 'mycell

End Sub

Sub startup()

Dim ccount As Integer
Dim cccount


Worksheets("Holidays").Select
Range("B5").Select

ActiveCell.FormulaR1C1
"=COUNTBYCOLOR(R[9]C[-1]:R[540]C[-1],38,FALSE)" '484

ccount = Range("b5")
Range("B6").Select
ActiveCell.FormulaR1C1 = "=countbyindex(R[8]C[2]:R[540]C[35])" '505

cccount = Range("B6").Value
Worksheets("holidays").Visible = True
Worksheets("Holiday Count").Visible = True
Worksheets("Xtra's & Count").Visible = True
Sheets("holidays").Activate

MsgBox "There Are " & ccount & " Holiday Clashes" & Chr(13) & "
There Have Been " & cccount & " accomodations" & Chr(13) & "Total Hour
" & Range("b10").Value & ", Hours Taken " & Range("b12").Value & ",
Hours Left to take " & Range("b11").Value, vbOKOnly, "Clash Count"

Call findvalue

Call dateselect
Worksheets("Names").Visible = False
With ThisWorkbook.Worksheets("Names").Cells(Rows.Count, "A").End(xlUp)
.offset(1, 0).Value = Range("A1").Text
.offset(1, 1).Value = Format(Now, "dd mmm yyyy, hh:mm")
.offset(1, 2).Value = Application.UserName
End With

Call logtrack

End Sub

Function countbycolor(InRange As Range, WhatColorIndex As Integer
Optional OfText As Boolean = False) As Long
Dim rng As Range
Application.Volatile True

For Each rng In InRange.Cells
If IsDate(rng) Then
If IsNumeric(rng) Then
countbycolor = countbycolor - _
(rng.Font.ColorIndex = WhatColorIndex)
Else
countbycolor = countbycolor - _
(rng.Interior.ColorIndex = WhatColorIndex)
End If
End If
Next rng
End Function

Function countbyindex(ByVal cbc As Range) As Integer

rng_col_count = cbc.Columns.Count
rng_row_count = cbc.Rows.Count

For times = 2 To rng_col_count Step 2
Set tmp_cbc = cbc.Range(Cells(1, times), Cells(rng_row_count,
times))
For Each i In tmp_cbc
If i.Interior.ColorIndex = 38 Then
If i = 1 And i <= 12 Then
f = f + 1
End If
End If
Next i
Next times

countbyindex = f
End Function

Sub logtrack()
Sheets("logged").Visible = True
With ThisWorkbook.Worksheets("logged").Cells(Rows.Count ,
"A").End(xlUp)
Sheets("logged").Visible = False
End With

End Sub

Sub findvalue()
Dim mycell
Dim findme As Range
Dim rng As Range
Dim offset
On Error Resume Next
Set rng = Range("findme1")
For Each mycell In rng
If mycell.Text = 129 Then
MsgBox (mycell.offset(0, -1).Text) & " Has Booked " & (mycell.Text -
128) & " Hours Off Over Their Quota of 128!", vbOKOnly, "More Than
Their Quota!"
End If
Next mycell
End Sub


--
Simon Lloyd
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708
View this thread: http://www.excelforum.com/showthread...hreadid=489095