1 Replies - 1051 Views - Last Post: 22 May 2014 - 03:54 AM Rate Topic: -----

#1 nighttrain  Icon User is offline

  • D.I.C Regular

Reputation: 6
  • View blog
  • Posts: 333
  • Joined: 22-September 10

VBA Compare between excel and word

Posted 21 May 2014 - 04:35 AM

I have problems with compare fields between excel and word. Normally the same strings but not in the same format.

1st Example:

string variable1 (in excel column): Title_of_book
string variable2 (in word paragraph): <<Title_of_book_>>

i would like to have compare of that as true because variable1 IS IN variable2. How to do that?

other example:

string variable1 (in excel column): Date_of_creation_document_2012
string variablw2 (in word column): «Date_of_creation_document_20»

here 12 was cutted somehow in Word but almost whole text is same and this is for sure that field associated so also should be marked as true in compare.

I tried by but its not working as assumed:

If InStr(variable1, variablw2) > 0 Then

generally i have no idea how to do such comparmission user of that file using excel as datasource for Word series corespondention and fields inside word associated with excel strings and in diffrent format lets say in excel are spaces and in word they are changed to _ or in excel ( ) in string are also changed to _ in word also in word we got << >> chars besides sometimes string in word is shorter. Thats the problem i got thats why mentioned examples i find out maybe to just compare some part of string if exist because comparing all that diffrences are not possible. What you think? I can of course share with all code i got.

Is This A Good Question/Topic? 0
  • +

Replies To: VBA Compare between excel and word

#2 nighttrain  Icon User is offline

  • D.I.C Regular

Reputation: 6
  • View blog
  • Posts: 333
  • Joined: 22-September 10

Re: VBA Compare between excel and word

Posted 22 May 2014 - 03:54 AM

any feedback on that? This is my code so far but i still have no idea how to program that:
Sub Sprawdz_Pola_Korespondencji_Click()

Application.ScreenUpdating = True

Dim RowNr As Integer
Dim EWS As Worksheet

RowNr = 30
Set EWS = Sheets("Arkusz do wypełnienia")


Dim FileName As Variant, wb As Workbook
FileName = Application.GetOpenFilename(FileFilter:="Word File (*.docx),*.docx", Title:="Select File To Be Opened")
If FileName = False Then Exit Sub
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True

Set WordDoc = WordApp.Documents.Open(FileName)
Dim p As Paragraph
Dim PoleWorld As String


Dim ExcelField As String
Dim WordField As String

X = 1

Do
        ExcelField = ""
        X = X + 1
        ExcelField = EWS.Cells(RowNr, X)
        
        If ExcelField <> "" Then
        
        ExcelField = ReplaceChars(ExcelField) ' zamiana spacji na _

            If ExcelField = "KONIEC" Then Exit Do
                
                For Each p In WordDoc.Paragraphs
                
                    WordField = CStr(p.Range.Text)
                    WordField = Replace(WordField, Chr(13), "")
                
                    'Check WordFile is not empty and start with «
                    If (WordField <> "" And WordField Like "*«*") Then   'sometimes in Excel columns are nulls we go next
                                                          
                      WordField = removeSpecial(WordField)
                                                 
                      '  If InStr(ExcelField, removeSpecial(WordField)) > 0 Then
                                           
                        'Instr(string to be searched, string to find)
                        'If string contains removeSpecial(WordField) (start searching from 1st letter

'If (ExcelField Like WordField & "*" Or InStr(ExcelField, WordField) Or WordField Like ExcelField & "*") Then
                        If (InStr(ExcelField, WordField)) Then
                        'If InStr(ExcelField, WordField) Then
                        
                                    Excel3LiteryOdLewej = Mid(ExcelField, 1, 9)
                                    Word3LiteryOdLewej = Mid(WordField, 1, 9)
                        
                                If Excel3LiteryOdLewej = Word3LiteryOdLewej Then
                        
                                    EWS.Cells(5, X).Interior.ColorIndex = 4
                                    Exit For 'field found in word exit and next
                                Else
                                    EWS.Cells(5, X).Interior.ColorIndex = 3
                                End If
                        
                        Else
                        
                        EWS.Cells(5, X).Interior.ColorIndex = 3
                        
                       
                        End If
                        
                        
                    End If
                    
                Next p
                
        End If

Loop Until EWS.Cells(RowNr, X) = "KONIEC"

WordDoc.Close savechanges:=False 'or false
WordApp.Quit
Set WordDoc = Nothing
Set WordApp = Nothing


'Dim rngParagraphs As Range
'Set rngParagraphs = Activedocument.Range(Start:=Activedocument.Paragraphs(1).Range.Start, End:=Activedocument.Paragraphs(4).Range.End)
'rngParagraphs.Select
    

'ngParagraphs.Find.Text = "Contoso"
'rngParagraphs.Find.Forward = True
'rngParagraphs.Find.MatchWholeWord = True

'If rngParagraphs.Find.Execute Then
 '   Wscript.Echo "The search text was found."
'Else
    'Wscript.Echo "The search text was not found."
'End If

End Sub

Function FindString(strCheck As String, strFind As String) As Boolean

    intPos = 0

    intPos = InStr(strCheck, strFind)

    FindString = intPos > 0

End Function

Function ReplaceChars(strInput As String) As String


    'Function to replace chars because word series corespondention converting it to _
    Public Function ReplaceChars(strInput As String) As String
    ' Replacesspaces in a string of text with underscores
    Dim Result As String
    Result = strInput
    
    Result = Replace(strInput, " ", "_")
    Result = Replace(Result, Chr(40), "_")   ' (
    Result = Replace(Result, Chr(41), "_")  ' )
    Result = Replace(Result, Chr(45), "")  ' )
    Result = Replace(Result, Chr(46), "")  ' )
    Result = Replace(Result, Chr(44), "")  ' )
    
    
    'jak zostanie jakas spacja to usun
    Result = Replace(strInput, " ", "")
       'If InStr(strInput, " ") > 0 Then
       ' Result = Replace(strInput, " ", "_")
       'End If
    
    'if it returns anything other than zero, the string is found.
    
    Dim Bool_input As Boolean
    
    Bool_input = InStr(Result, "__") <> 0
    If Bool_input = True Then
        Result = Replace(Result, "__", "_")  '
    End If
    
    
    'aby wyeliminowac _ na kocnu stringa w Excel field
    a = 0
    Do While Right(Result, 1) = "_"
    Result = Left(Result, Len(Result) - 1)
    a = a + 1
    Loop
    
    
     ReplaceChars = Result
    
    End Function


Function removeSpecial(sInput As String) As String
    Dim sSpecialChars As String
    Dim i As Long
    sSpecialChars = "\/:*?™""®<>|.&@# (+`©~);-+=^$«»!,'" 'This is your list of characters to be removed
    For i = 1 To Len(sSpecialChars)
        sInput = Replace$(sInput, Mid$(sSpecialChars, i, 1), " ") 'if "" - this will remove spaces
    Next
       
Dim a As Integer
Do While Left(sInput, 1) = " "
     sInput = Mid(sInput, 2)
a = a + 1
Loop
 
   
a = 0
Do While Right(sInput, 1) = " "
    sInput = Left(sInput, Len(sInput) - 1)
a = a + 1
Loop

removeSpecial = sInput
End Function




the most important line:
 If (InStr(ExcelField, WordField)) Then


This post has been edited by nighttrain: 22 May 2014 - 04:30 AM

Was This Post Helpful? 0
  • +
  • -

Page 1 of 1