PDA

View Full Version : Highlighting cells that contain specific characters with VBA



omar23j
08-03-2018, 02:16 PM
Hi, I have a script that extract information from multiple word documents and put them in an excel table. I want to implement an 'error proof'' function to highlight in red any cell (in excel) that contain unexpected characters such as ',' , '%' , etc....

My code is shown below.
Thanks in advance for the help.



Sub extract()Dim doclist As String, sPath As String
Dim i As Integer
Set wordapp = CreateObject("Word.Application")
sPath = "C:\Users\ocherkaoui\Desktop\VBA-DOCS\"
doclist = Dir(sPath & "*.doc*")
i = 1
Do While doclist <> ""
Set worddoc = wordapp.documents.Open(sPath & doclist)
Set tbl = worddoc.tables(1)
Cells(i, 1) = Right(Left(tbl.Cell(1, 2).Range.Text, Len(tbl.Cell(1, 2).Range.Text) - 1), Len(tbl.Cell(1, 2).Range.Text) - 11)
Cells(i, 2) = Left(tbl.Cell(6, 2).Range.Text, Len(tbl.Cell(6, 2).Range.Text) - 1)
i = i + 1
worddoc.Close
Set worddoc = Nothing
Set tbl = Nothing
doclist = Dir()
Loop
End Sub

p45cal
08-03-2018, 02:40 PM
Try:

Sub extract()
Dim doclist As String, sPath As String
Dim i As Integer

Set wordapp = CreateObject("Word.Application")
sPath = "C:\Users\ocherkaoui\Desktop\VBA-DOCS\"
doclist = Dir(sPath & "*.doc*")
i = 1
Do While doclist <> ""
Set worddoc = wordapp.documents.Open(sPath & doclist)
Set tbl = worddoc.tables(1)
Cells(i, 1) = Right(Left(tbl.Cell(1, 2).Range.Text, Len(tbl.Cell(1, 2).Range.Text) - 1), Len(tbl.Cell(1, 2).Range.Text) - 11)
TestForUnexpectedCharacters Cells(i, 1)
Cells(i, 2) = Left(tbl.Cell(6, 2).Range.Text, Len(tbl.Cell(6, 2).Range.Text) - 1)
TestForUnexpectedCharacters Cells(i, 2)
i = i + 1
worddoc.Close
Set worddoc = Nothing
Set tbl = Nothing
doclist = Dir()
Loop
End Sub


Sub TestForUnexpectedCharacters(cll As Range)
UnexpectedCharacterList = "@~#'%" 'adjust to contain what you think are unexpected characters.
For c = 1 To Len(cll.Value)
If InStr(1, UnexpectedCharacterList, Mid(cll.Value, c, 1), vbTextCompare) > 0 Then
cll.Font.Color = vbRed
Exit For
End If
Next c
End Sub

omar23j
08-06-2018, 02:24 PM
thank you infinitely, this works!

omar23j
08-08-2018, 01:35 PM
Hi again,

First thank again the error proofing sub works like magic. Also I was wondering if you could help me with one last thing. I might run this macro once every 3 months to keep track of change in data. Every subsequent time I run the macro, I would like to have cells whose value have changed (on the excel sheet) to become of yellow font.

However there is a little challenge. The number of active word files being extracted to excel in 3 month from now might not be the same ( new word files, discarded world files). And thus, we cannot directly compare say row 2 with the old row 2 because they might be values extracted from 2 different documents. I have no idea how to deal with this but if it's possible for you to come up with something, I would be eternally grateful!