PDA

View Full Version : [SOLVED:] Urgent Help Required



Khanonline
12-29-2014, 11:42 AM
I am having problem in using code by macropod.
Sub BulkFindReplace()
Application.ScreenUpdating = True
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
Dim xlFList As String, xlRList As String, i As Long, Rslt
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\Workbook Name.xls"
StrWkSht = "Sheet1"
If Dir(StrWkBkNm) = "" Then
MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
Exit Sub
End If
' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
' Record that we've started Excel.
bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
'Hide our Excel session
If bStrt = True Then .Visible = False
For Each xlWkBk In .Workbooks
If xlWkBk.FullName = StrWkBkNm Then ' It's open
Set xlWkBk = xlWkBk
bFound = True
Exit For
End If
Next
' If not open by the current user.
If bFound = False Then
' Check if another user has it open.
If IsFileLocked(StrWkBkNm) = True Then
' Report and exit if true
MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
If bStrt = True Then .Quit
Exit Sub
End If
' The file is available, so open it.
Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
If xlWkBk Is Nothing Then
MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
If bStrt = True Then .Quit
Exit Sub
End If
End If
' Process the workbook.
With xlWkBk.Worksheets(StrWkSht)
' Find the last-used row in column A.
' Add 1 to get the next row for data-entry.
iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
' Output the captured data.
For i = 1 To iDataRow
' Skip over empty fields to preserve the underlying cell contents.
If Trim(.Range("A" & i)) <> vbNullString Then
xlFList = xlFList & "|" & Trim(.Range("A" & i))
xlRList = xlRList & "|" & Trim(.Range("B" & i))
End If
Next
End With
If bFound = False Then xlWkBk.Close False
If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Process each word from the F/R List
For i = 1 To UBound(Split(xlFList, "|"))
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindStop
.Text = Split(xlFList, "|")(i)
.Execute
'To automatically change the found text:
'• comment-out/delete the previous line and the Do While Loop
'• uncomment the next two lines
'.Replacement.Text = Split(xlRList, "|")(i)
'.Execute Replace:=wdReplaceAll
End With
'Ask the user whether to change the found text
Do While .Find.Found
.Duplicate.Select
Rslt = MsgBox("Replace this instance of:" & vbCr & _
Split(xlFList, "|")(i) & vbCr & "with:" & vbCr & _
Split(xlRList, "|")(i), vbYesNoCancel)
If Rslt = vbCancel Then Exit Sub
If Rslt = vbYes Then .Text = Split(xlRList, "|")(i)
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
Application.ScreenUpdating = True
End Sub
'
Function IsFileLocked(strFileName As String) As Boolean
On Error Resume Next
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
IsFileLocked = Err.Number
Err.Clear
End Function


When I replace text in MS word through this Macro it replaces a some portion of Word as well. I want this should
replace the words if complete caption is found other wise it left as it is.
For more clarification please have a look at Word file (Macro Executed ,xls file also attached).
I want just complete captions should have to be replaced.
Thanks.

gmayor
12-29-2014, 11:43 PM
With regard to the particular example, the problem relates to what Word sees as a word to be changed. If you change Paul's code to

With .Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = True
.MatchCase = True
.Wrap = wdFindStop
.Text = "<" & Split(xlFList, "|")(i) & ">"
.Execute

only the required changes are made. The <> brackets are used as wildcard start and end of word markers.
Paul will no doubt be along later with his observations.

Your much larger data set causes the macro to error, no doubt because line 1065 is too long to process as a VBA string.
Whenj posting code, click the # button and paste the code between the resulting pair of CODE markers. I didn't do that here because I wanted to highlight the rows to change.

Khanonline
12-29-2014, 11:55 PM
Thanks Gmayor. With your help Its managed.

:pleased:

Khanonline
12-30-2014, 03:32 AM
Hi,

While working with that I have got the attached error.

Can you please guide me on this?

On debug I was directed to following Line of Code.

.Text = "<" & Split(xlFList, "|")(i) & ">"
.Execute

Can I get any other solution for such situations?

Thanks

Best
Khanonline

gmayor
12-30-2014, 04:04 AM
Without knowing what you are searching for it is impossible to answer. The suggested code should work in the context of the particular issue that you quoted. At what point did the error occur? What was the data the code was trying to work with?

Khanonline
12-30-2014, 04:36 AM
I have data of some Italian Language in Ms Word File. In Ms Excel I have some Terms already Translated.
Simply I need a macro ; if in Ms Word Table any of the Value complete matched in Ms Excel's Column A (Native Italian) then it should be replaced with Column B of same row (as English is there).

Can I have you chat ID? My ID is Faziz2.mcs2@gmail.com.

Thanks