I have problems with compare fields between excel and word. Normally the same strings but not in the same format.
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?
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.
Page 1 of 1
1 Replies - 1059 Views - Last Post: 22 May 2014 - 03:54 AM
Replies To: VBA Compare between excel and word
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:
the most important line:
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
Page 1 of 1