I modified only the names in the code like this:

Sub test()
Dim ole As OLEObject
Set ole = Worksheets("Main").OLEObjects("txtbx1")
ole.Parent.Activate
ole.Activate

End Sub

Sorry!! The code showed no response!!
I mean the cursor didn't blink in the txtbx1

"Peter T" wrote:

When you say the code didn't work try and explain what you mean. Did it
error, if so one what line, what error message.

The code should work, did you adjust all the names correctly. Start with a
simple macro exactly as posted. Put am ActiveX Textbox named "Textbox1" on
"Sheet1" of the activeworkbook. Select a cell on sheet1. Activate a
different sheet. Run the macro.

Regards,
Peter T

"Rose Tamang 2001" wrote in
message ...
Hey Pete,

Exactly, I have named the sheet1 as 'Main'
The code didn't work. I don't see the cursor blink in the txtbx1

"Peter T" wrote:

I'm not sure what you consider is the main sheet. Assuming txtbx1 is an
ActiveX textbox maybe you can adapt the following to your needs -

Sub test()
Dim ole As OLEObject
Set ole = Worksheets("Sheet1").OLEObjects("Textbox1")
ole.Parent.Activate
ole.Activate

End Sub

Regards,
Peter T

"Rose Tamang 2001" wrote in
message ...
Hi, Peter,

It worked fine!! Can you please help me to set focus on txtbx1 in the
main
sheet??

"Peter T" wrote:

Ah of course, you don't want to search the destination sheet

Set DestSht = WorkSheets("Sheet1")
' code

For Each Sh In ActiveWorkbook.Worksheets
If Sh.Name < DestSht.Name Then
' code

End If
Next

You might want to first delete all previous entries in the destination
sheet, or include some code to start NewRow below the last entry.

Regards,
Peter T

"Rose Tamang 2001" wrote in
message ...
Hey Peter, your code worked fine. But a problem!

The code displayed 5000 rows with the same entry in the Set DestSht
=
Sheets("Sheet1"). How to avoid the Sheet 1?


"Peter T" wrote:

Private Sub cmdbtn1_Click()
Dim NewRow As Long
Dim firstAddress As String, sWhat As String
Dim sAddr As String, sMsg As String
Dim rFound As Range
Dim Sh As Worksheet
Dim FoundIt As Boolean
Dim DestSht As Worksheet

Set DestSht = Sheets("Sheet1")
NewRow = 12

sAddr = "B4: B5000"
'e = "B1:B5000"
Let sWhat = txtbx1.Value

If Len(sWhat) = 2 Then
sWhat = "*" & sWhat & "*"
ElseIf Len(sWhat) < 2 Then
If Len(sWhat) = 1 Then
sMsg = "You only enered one character"
Else
sMsg = "You haven't typed anything in the Search Box" &
_
vbNewLine & "Contact:US"
End If
MsgBox sMsg, , "Help!!"
Exit Sub
End If

For Each Sh In ActiveWorkbook.Worksheets
With Sh.Range(sAddr)

Set rFound = .Find(sWhat, LookIn:=xlValues,
LookAt:=xlWhole,
_
SearchOrder:=xlByRows)

If Not rFound Is Nothing Then
firstAddress = rFound.Address
Do
DestSht.Range("B" & NewRow & ":H" &
NewRow).Value
= _
rFound.Resize(,
7).Value
DestSht.Range("A" & NewRow) = Sh.Name
NewRow = NewRow + 1
FoundIt = True
Set rFound = .FindNext(after:=rFound)
Loop While Not rFound Is Nothing And _
rFound.Address < firstAddress
End If
End With

Next
If FoundIt = False Then
MsgBox "Data not found!!", , "Sorry!!"
End If

End Sub

Regards,
Peter T


"Rose Tamang 2001" wrote
in
message ...
Dear Friends,

I've this code seaching sheets for a specific word and display
it.
At this time the code accepts only a correct spellings. If wrong
a
msg
box
is displayed. I want, that code should accept any two english
alphabets
typed
in the text box and display the result with words that contains
two
letters

Any idea!! Help!!

Private Sub cmdbtn1_Click()
Dim Sh As Worksheet
Dim FoundIt As Boolean
Set DestSht = Sheets("Main")
NewRow = 12

d = "B4: B5000"
'e = "B1:B5000"
Let c = txtbx1.Value

For Each Sh In ActiveWorkbook.Worksheets
With Sh.Range(d)
Set b = .Find(c, LookIn:=xlValues, LookAt:=xlWhole,
SearchOrder:=xlByRows)

If c = "" Then
MsgBox "You haven't typed anything in the Search Box" &
vbNewLine
&
"Contact:US", , "Help!!"
Exit Sub



ElseIf Not b Is Nothing Then
firstAddress = b.Address
lbl1.Caption = b




Do
Sh.Range("B" & b.Row & ":H" & b.Row).Copy
Destination:=DestSht.Range("B" &
NewRow)
DestSht.Range("A" & NewRow) = Sh.Name
NewRow = NewRow + 1
FoundIt = True
Set b = .FindNext(after:=b)
Loop While Not b Is Nothing And b.Address < firstAddress
End If
End With




Next
If FoundIt = False Then
MsgBox "Data not found!!", , "Sorry!!"
End If

End Sub
Private Sub cmdbtn2_Click()
lbl1.Caption = ""
txtbx1.Value = ""
LastRow = Rows.Count
Rows("12:" & LastRow).Delete

End Sub


.



.



.



.