Hello tobiahjadam,

Welcome to the Forum!

This macro may need some changes. It was written using the following assumptions: The keywords are on a separate sheet and in a single column, and the rows being searched are on a separate sheet in a single column.

If your data is not arranged this way then you need to show me how it is arranged. I can then change the macro to work with the data.

Here is the macro code. Data for both sheets starts in cell "A1".
Sub FindAndReplace()

  Dim Data As Variant
  Dim I As Integer
  Dim KeyWord As String
  Dim KeyWords As Object
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  Dim Word As Variant
  Dim Words As Variant
  
    Set KeyWords = CreateObject("Scripting.Dictionary")
    KeyWords.CompareMode = vbTextCompare
    
    Set Wks = Worksheets("Sheet2")
    Set Rng = Wks.Range("A1")
    Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
    
    Words = IIf(RngEnd.Row < Rng.Row, Rng.Value, Wks.Range(Rng, RngEnd).Value)
    
    For Each Word In Words
      If Not KeyWords.Exists(Word) Then
         KeyWords.Add Word, 1
      End If
    Next Word
    
      Set Wks = Worksheets("Sheet1")
      Set Rng = Wks.Range("A1")
      Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
      Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
      
      ReDim Data(1 To Rng.Rows.Count, 1 To 1)
      Data = Rng.Value
      
        For I = 1 To UBound(Data, 1)
          Words = Split(Data, " ")
            For Each Word In Words
              If KeyWords.Exists(Word) Then
                 Data(I, 1) = Word
                 Exit For
              End If
            Next Word
        Next I
        
        Rng.Value = Data
      
End Sub