[devcon]

Τάσο καλημέρα,

Τις παρατηρήσεις σου που μου έστειλες δεν τις χρησιμοποίησα ακόμη λόγω χρόνου.
Ελπίζω μέσα στο Σαββατοκύριακο να τις δω και να ασχοληθώ όπως μου προτείνεις.

Ως προς το κωδικό που μου ζητάς είναι o ακόλουθος.
Θα επανέλθω με τα υπόλοιπα.

Ευχαριστώ
Θανάσης

Sub Bold_Italic_Keywords()
Dim vntWords As Variant
Dim lngIndex As Long
Dim rngFind As Range
Dim strFirstAddress As String
Dim lngPos As Long

vntWords = Array("MAKER", "NON-RETURNABLE", "OFFER:", "DELIVERY TIME:", "EX STOCK", "NOT AVAILABLE", "EX WORK")
With ActiveSheet.UsedRange
    For lngIndex = LBound(vntWords) To UBound(vntWords)
        Set rngFind = .Find(vntWords(lngIndex), LookIn:=xlValues, LookAt:=xlPart)
        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address
            Do
                lngPos = 0
                Do
                    lngPos = InStr(lngPos + 1, rngFind.Value, vntWords(lngIndex), vbTextCompare)
                    If lngPos > 0 Then
                        With rngFind.Characters(lngPos, Len(vntWords(lngIndex)))
                            .Font.Bold = True
                            .Font.Italic = True
                            '.Font.Size = .Font.Size + 2
                            '.Font.ColorIndex = 3
                        End With
                    End If
                Loop While lngPos > 0
                Set rngFind = .FindNext(rngFind)
            Loop While rngFind.Address <> strFirstAddress
        End If
    Next
End With
End Sub