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

The named ranges cover these cells:- Hols1 $D$14:$AK$121, Hols2
$D$122:$AK$334, Hols3 $D$335:$AK$416, these ranges are consecutive on
one sheet all rows that the user can enter new dates in before sort on
close are below row 121, when closed the program sorts by date but
named ranges wont expand.

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 t1 =
"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 Hours " &
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=489420