Hi Len,

Not completely confident that I fully understand but try the following and
see if it does what you want. It has validation to ensure that a valid string
is inserted and that the worksheet does not already extist. Also converts
input string to uppercase and the string being compared to uppercase in case
the user enters in lowercase.

It also copies the headers from budget sheet to new sheet.

Let me know how it goes.

Note that a space and underscore at the end of a line is a line break in an
otherwise single line of code.

Sub Test()

Dim sTarget As String
Dim rngTarg As Range
Dim wsNew As Worksheet
Dim iLastRow
Dim i

'Convert input to uppercase
sTarget = UCase(InputBox("Enter search target"))

If Len(sTarget) = 0 Then
MsgBox "Nothing to do"
Exit Sub
End If

'Test if input string exists in column A
With Sheets("Budget")
Set rngTarg = .Columns("A") _
.Find(What:=sTarget, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
End With

'If inpput string does not exist then
'do not create new worksheet.
If rngTarg Is Nothing Then
MsgBox sTarget & " does not exist." & vbCrLf _
& "Processing terminated."
Exit Sub
End If

'Test if worksheet already exists before
'attempting to add a new one by that name
On Error Resume Next
Set wsNew = Sheets(sTarget)
If Err.Number = 0 Then
MsgBox "Sheet " & sTarget & " exists." _
& vbCrLf & "Processing terminated."
Exit Sub
End If
On Error GoTo 0 'Reset error trapping

'Add the new worksheet and name it
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = sTarget

'Assign new worksheet to a variable
Set wsNew = ActiveSheet

With Worksheets("Budget")
'copy column headers to new worksheet
.Rows(1).Copy wsNew.Cells(1, 1)

iLastRow = .Cells(.Rows.Count, "A") _
.End(xlUp).Row

'Starting row 2 assumes you have column headers
For i = 2 To iLastRow

'Convert comparison cell value to uppercase
If UCase(.Cells(i, "A").Value) = sTarget Then
.Rows(i).Copy _
wsNew.Cells(wsNew.Rows.Count, 1) _
.End(xlUp).Offset(1, 0)

End If
Next i
End With
wsNew.Columns.AutoFit
wsNew.Select

End Sub

--
Regards,

OssieMac