ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Question?? (https://www.excelbanter.com/excel-programming/328755-question.html)

Paul Mak

Question??
 
I have the following function to search and highlight text with matching
keywords from the Access table. It did not work and I am pretty sure that
there are something wrong with my coding. Please help.


Sub FindAndHighlight()
Dim iStart As Long
Dim iFound As Long
Dim s As String
Dim db As DAO.Database
Dim rst1 As DAO.Recordset
Dim strKeyword As String

'Loop throught each keyword to find the match text in Excel file
Set db = CurrentDb
Set rst1 = db.OpenRecordset("SELECT Tbl_CYSN_Keywords.CYSNKeywordID,
Tbl_CYSN_Keywords.CYSNKeyword FROM Tbl_CYSN_Keywords;")
On Error Resume Next
If Not rst1.BOF Then
rst1.MoveFirst
Do While Not rst1.EOF
strKeyword = strQuote & rst1!CYSNKeyword & strQuote
Columns("T:V").Select
Cells.Find(What:=strKeyword, After:=ActiveCell,
LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:=False, SearchFormat:=False).Activate
s = ActiveCell.Select
For Each s In Selection
iStart = 1
iFound = InStr(iStart, s, strKeyword, vbTextCompare)

Do While iFound < 0
With c.Characters(Start:=iFound,
Length:=Len(strKeyword)).Font
.FontStyle = "Bold"
.Color = vbRed
End With
iStart = iFound + 1
iFound = InStr(iStart, s, strKeyword,
vbTextCompare)
Loop
Next c
Cells.FindNext(After:=ActiveCell).Activate
rst1.MoveNext
Loop
End If
rst1.Close
Set rst1 = Nothing
Set db = Nothing
End Sub




All times are GMT +1. The time now is 12:14 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com