View Single Post
 
Old 07-10-2017, 06:45 AM
jakecahill jakecahill is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Jul 2017
Posts: 2
jakecahill is on a distinguished road
Question VBA script runs once but if I try to run it again, it does not work

Hello,

I wrote a VBA script to check a table in a word document for terms that are stored in an Excel spreadsheet.

The first time I run it, everything works fine.

Every other time results in an Object is invalid error and Excel won't even let me open the spreadsheet manually. Instead, I have to restart my PC to be able to open it again.


This is the script:
Code:
Public Sub CheckTableCells()

Dim oCell As Cell
Dim oRow As Row
Dim MyRange As Range
Dim Rng As Variant
Dim findText As String
Dim x1 As Excel.Application
Dim wkbk As Excel.Workbook
Dim wksh As Excel.Worksheet

Set x1 = New Excel.Application

x1.Workbooks.Close
Set wkbk = x1.Workbooks.Open(FileName:="F:\Blatchford termbase_MASTER.xlsx", ReadOnly:=True)
Set wksh = wkbk.Sheets(1)

If x1.Ready = True Then
LastRow = wksh.Columns(1).SpecialCells(xlLastCell).Row
Set Rng = wksh.Range(Cells(1, 1), Cells(LastRow, 1))
 Debug.Print Rng(1).Text
    For x = 1 To Rng.Count
        
        If Not Rng(x) Is Nothing Then
          
            findText = Rng(x).Text
            For Each oRow In Selection.Tables(1).Rows
    For Each oCell In oRow.Cells
        Set MyRange = oCell.Range
        
        Do While True
        MyRange.Find.Highlight = True
        MyRange.Find.MatchWildcards = False
        MyRange.Find.MatchWholeWord = True
        MyRange.Find.Forward = True
        MyRange.Find.IgnorePunct = True
        MyRange.Find.Execute (findText)
        
            If MyRange.Find.Found Then
           Debug.Print oCell.Range.Text
            With MyRange.Font
            .ColorIndex = wdGreen
            .Bold = True
            End With
            
            
            Else
            Exit Do
            End If
        Loop
    Next oCell
Next oRow
            
        Else
            MsgBox "Nothing found"
            Exit For
        End If
        
    Next x
x1.Workbooks.Close
Else
End
End If

End Sub
Reply With Quote