Dan

Generally, when you create a Word Application object and open a document, it
won't show you the application unless you explicitly set Visible to True.
At least that's what happens on my machine using Off2000 and Win98SE. So my
experience is that Excel doesn't lose the focus.

It may happen, however, when you use a Select statement in Word. I don't
know of anyway to get it back, other than what you've done.

It tried to test your code a little more extensively, but the
..ClearFormatting line (or any line using the Find object) causes an Excel
crash.

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"Dan" wrote in message
...
Okay, so I figured out how to do it, and it works pretty nicely, but I'd
still be glad to hear of any possible improvements. One thing I couldn't
figure out how to do was make Excel the active applicaton again after having
opened the word document. I want Excel to be the application on screen
while the macro is running. The only solution I could come up with was
setting word visible = false. Any way to just "activate" excel?

Public Sub test()

Dim wd As Object
Dim tempvar As String
Dim xlapp As Excel.Application
Dim wdAPP As Word.Application
Dim wdDoc As Word.Document
Dim response As VbMsgBoxResult
Set xlapp = Excel.Application
sRNM = Application.GetOpenFilename("Word Files (*.doc), *.doc")
If sRNM = False Then
GoTo es
End If
' With Dialogs(xlDialogFileOpen)
' If .Display Then
' sRNM = WordBasic.FilenameInfo$(.Name, 1)
' End If
' End With

Set wdAPP = CreateObject("Word.Application")
Set wdDoc = wdAPP.Documents.Open(sRNM)


wdAPP.Visible = False



For i = 2 To 1002
xlapp.Goto Reference:=Rows(i).Columns("B")
tempvar = Application.Selection
With wdAPP.Selection.Find
.ClearFormatting
.MatchWildcards = False
.MatchCase = True
.Forward = True
.Wrap = wdFindContinue
.Text = tempvar
.Execute
End With
If wdAPP.Selection.Find.found = True Then
With wdAPP.Selection
.MoveLeft unit:=wdCell, Count:=1
.selectcell
.Copy
End With
xlapp.Goto Reference:=Rows(i).Columns("A")
tempvar2 = Application.Selection
If tempvar2 < "" Then
response = MsgBox("There is already an ID here! Continue
Running?", vbYesNo)
If response = vbNo Then
wdAPP.Quit savechanges = False
GoTo es
End If
Else
xlapp.ActiveSheet.Paste Destination:=Rows(i).Columns("A")
End If
End If
Next
wdAPP.Visible = True
wdAPP.Quit savechanges = False
Set wdAPP = Nothing
Set wdDoc = Nothing
es:
End Sub