On Jan 9, 3:33*pm, OssieMac
wrote:
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

Hi OssieMac,

Great, your codes work perfectly for each input entry
However, If we have more than one input entry, then it will take each
time to process
In this case, how to modify your codes to process for say 10 input
text "ADP", "CBUS" BIT"...., to distribute the data range into
respective worksheets under the same workbook

Thanks again

Regards
Len