Betingelse for at køre script...

Dvs den skal fx køre koden på alle celler i kolonne C hvis Kolonne B indeholder tallet 5

If WorksheetFunction.CountIf(Range("B:B"), 5)=1 Then MsgBox "ja"

hvis der er flere:
If WorksheetFunction.CountIf(Range("B:B"), 5)>0 Then MsgBox "ja"

Det er igen i forbindelse med koden til søgning.
Jeg har 20000 linier hvor det faktisk kun er ca 200 der skal søges i, troede jeg kunne filtrere mig ud af problemet.
Nå men faktum er at kolonne B indeholder det 5-tal som definere de 200linier, kolonne I indeholder mine tekststrenge.

Tak for hjælpen!!!

Sub søgord()

On Error Resume Next
'---------------------------
Dim bok1 As Workbook
Dim bok2 As Workbook
Set bok1 = Workbooks("søgeord.xlsm")
Set rng1 = bok1.Sheets(1).Range("A1:A" & bok1.Sheets(1).Cells(65536, 1).End(xlUp).Row)

Set bok2 = Workbooks("alt.xlsm")
Set rng2 = bok2.Sheets(1).Range("I1:I" & bok2.Sheets(1).Cells(65536, 1).End(xlUp).Row)

'---------------------------
    Dim varX As String
    Dim FindOrd As String
    Dim varY As String
    FindOrd = ""
        For Each C In rng2 'Tekststrenge i kolonne I
            FindOrd = ""
            For Each x In rng1 'Mine søgeord
                varX = InStr(1, C.Value, x.Value)
                If varX <> 0 Then
                    varY = InStr(varX, C.Value, " ")
                    If varY = 0 Then
                        FindOrd = FindOrd & Mid(C.Value, varX, Len(C.Value)) & ""
                    Else
                        FindOrd = FindOrd & Mid(C.Value, varX, varY - varX) & ""
                    End If
                End If
            Next x
            C.Offset(0, 1).Value = FindOrd
        Next C
End Sub

Det skulle nok være muligt at filtrere uønsket data fra så kun aktuelle rækker testes.

Det nemmeste var hvis du sendte filerne

alternativt besvar :

I hvilken Projektmappe har du makroen ?
I hvilken Projektmappe har du nogle 5'er i kolonne B ?

et par eks. på værdier i kol A i "søgeord.xlsm" ?
et par eks. på værdier i kol I i "alt.xlsm" ?

Smid et svar excelent! Tak for hjælpen

Sub E()

On Error Resume Next
'---------------------------
Dim bok1 As Workbook
Dim bok2 As Workbook
Set bok1 = Workbooks("søgeord.xlsm")
Set rng1 = bok1.Sheets(1).Range("A1:A" & bok1.Sheets(1).Cells(65536, "A").End(xlUp).Row)

Set bok2 = Workbooks("alt.xlsm")
rk = bok2.Sheets(1).Cells(65536, "I").End(xlUp).Row
bok2.Sheets(1).Range("B1:B" & rk).AutoFilter Field:=1, Criteria1:="5"
bok2.Sheets(1).Range("I1:I" & rk).SpecialCells(xlCellTypeVisible).Select
Set rng2 = Selection
Selection.AutoFilter
'---------------------------
    Dim varX As String
    Dim FindOrd As String
    Dim varY As String
    FindOrd = ""
        For Each C In rng2 'Tekststrenge i kolonne I
            FindOrd = ""
            For Each x In rng1 'Mine søgeord
                varX = InStr(1, C.Value, x.Value)
                If varX <> 0 Then
                    varY = InStr(varX, C.Value, " ")
                    If varY = 0 Then
                        FindOrd = FindOrd & Mid(C.Value, varX, Len(C.Value)) & ""
                    Else
                        FindOrd = FindOrd & Mid(C.Value, varX, varY - varX) & ""
                    End If
                End If
            Next x
            C.Offset(0, 1).Value = FindOrd
        Next C

End Sub

velbekom