Something like;

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

Dim wks As Worksheet
Dim myVal As String
Dim resp As Long

'too many cells at once!
If Target.Cells.Count 1 Then Exit Sub

'Must be in column A (=1)
If Target.Column < 1 Then Exit Sub

'must be after row 1
If Target.Row < 2 Then Exit Sub

myVal = CStr(Target.Value)

Set wks = Nothing
On Error Resume Next
Set wks = Worksheets(myVal)
On Error GoTo 0

If wks Is Nothing Then
'worksheet doesn't already exist
Set wks = Worksheets.Add(after:=Target.Parent)
wks.Cells(1, 1).Value = "Date"
wks.Cells(1, 2).Value = "Title"
wks.Cells(1, 3).Value = "Anything else you want to add"
'etc
Me.Activate
On Error Resume Next
wks.Name = myVal
If Err.Number 0 Then
Application.ScreenUpdating = True
If MsgBox(prompt:="Can't add this sheet." & vbLf & _
"Should I delete the new one?", _
Buttons:=vbYesNo + vbCritical, _
Title:="Warning") = vbYes Then
Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
Else
MsgBox "Please Rename " & wks.Name & " manually"
End If
Application.ScreenUpdating = False
End If
On Error GoTo 0
Else
MsgBox "A worksheet named " & wks.Name & " already exists" & _
vbLf & "Not added!", Buttons:=vbCritical
End If

End Su

--
Message posted from http://www.ExcelForum.com