Replacing unknown values/text in the same cell as a known word

[JaspeR_Etzi]

Hey you all,
I am pretty much a newbie to the whole Excel macro area and I tried my best to Google the answer for my problem but couldn't quite find a satisfying solution to it. So what I am trying to do is to censor all names from an Excel file by replacing the very next word of "herr", and "frau" (German for man and woman) to "*****". I have a working code that can replace certain words in an Excel spreadsheet but I am still trying to figure out how I can replace "the word next to the word" so to speak. Can anyone help me out with this?
Here is the code:

Sub FindandReplaceText()
'Update by Extendoffice 2018/5/24
Dim xFind As String
Dim xRep As String
Dim xRg As Range
On Error Resume Next
Set xRg =Cells
xFind = Application.InputBox("word to search:", "Kutools for Excel", , , , , 2)
xRep = Application.InputBox("word to replace:", "Kutools for Excel", , , , , 2)
If xFind = "False" Or xRep = "False" Then Exit Sub
xRg.Replace xFind, xRep, xlPart, xlByRows, False, False, False, False
End Sub

 

[Tim_Excel_]

Jasper,

What is the range of cells you want to edit? And what are the values of this cells like? Do they only contain "Herr Name" or do they contain a longer string?

 

[JaspeR_Etzi]

I wrote a program using python that automatically sorts answers from a csv file into an xlxs document depending on the keywords that were used in the answers. In those answers (which contain alot of words most of the time) are sometimes names which I want to filter out to prevent data leaks. The range is up to 10000 rows in most cases but highly depend on the file (there are multiple with different amount but they are all in the same format). The answers also are only in the 3 collumn.

 

[Tim_Excel_]

I'm sure this could be done more elegantly but it works. Sub checks for Herr and Frau, returns the first and last char number of these words and replaces the names with asterisks. Make sure to edit the ranges to suit your WB.

Sub repl()s = 1
start:
charnHerr = InStr(s, ThisWorkbook.Sheets(1).Range("A1").Value, "Herr")
charnFrau = InStr(s, ThisWorkbook.Sheets(1).Range("A1").Value, "Frau")


If charnHerr = "0" And charnFrau = "0" Then Exit Sub


If charnHerr > charnFrau And Not charnFrau = "0" Then
GoTo Frau
Else
GoTo Herr
End If


Herr:
If charnHerr <> "0" Then
For Each cell In ThisWorkbook.Sheets(1).Range("A1")
    For i = charnHerr + 5 To Len(cell)
        Select Case Asc(Mid(cell.Value, i, 1))
            Case 48 To 57, 65 To 90, 79 To 122
            Case Else
            rv = Mid(cell.Value, charnHerr + 5, i - charnHerr - 5)
            replaceValue = Replace(cell, rv, "*****")
            cell.Value = replaceValue
            s = charnHerr + 5
            GoTo start
        End Select
    Next i
Next


End If


Frau:
If charnFrau <> "0" Then
For Each cell In ThisWorkbook.Sheets(1).Range("A1")
    For i = charnFrau + 5 To Len(cell)
        Select Case Asc(Mid(cell.Value, i, 1))
            Case 48 To 57, 65 To 90, 79 To 122
            Case Else
            rv = Mid(cell.Value, charnFrau + 5, i - charnFrau - 5)
            replaceValue = Replace(cell, rv, "*****")
            cell.Value = replaceValue
            s = charnFrau + 5
            GoTo start
        End Select
    Next i
Next


End If
End Sub

 

[Fluff]

Another option

Sub ReplaceNextWord()
   Dim Ary As Variant, x As Variant, v As Variant
   Dim i As Long
   Ary = Range("C1", Range("C" & Rows.count).End(xlUp))
   For i = 2 To UBound(Ary)
      x = Split(Ary(i, 1), " ")
      v = Application.Match("herr", x, 0)
      If Not IsError(v) Then
         x(v) = String(Len(x(v)), "*")
         Ary(i, 1) = Join(x, " ")
      End If
      v = Application.Match("frau", x, 0)
      If Not IsError(v) Then
         x(v) = String(Len(x(v)), "*")
         Ary(i, 1) = Join(x, " ")
      End If
   Next i
   Range("C1").Resize(UBound(Ary)).Value = Application.Index(Ary, 0, 1)
End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

.. a couple of more options.

Sub Censor_Herr_Frau_v1()
  Dim a As Variant
  Dim i As Long
  
  With Range("A1", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    With CreateObject("VBScript.RegExp")
      .Global = True
      .IgnoreCase = True
      .Pattern = "(\b(Frau|Herr)\b )([^ ]+)"
      For i = 1 To UBound(a)
        a(i, 1) = .Replace(a(i, 1), "$1*****")
      Next i
    End With
    .Value = a
  End With
End Sub


Sub Censor_Herr_Frau_v2()
  Dim a As Variant, wrds As Variant
  Dim i As Long, j As Long
  
  With Range("A1", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      wrds = Split(a(i, 1))
      For j = 0 To UBound(wrds) - 1
        If LCase(wrds(j)) = "frau" Or LCase(wrds(j)) = "herr" Then wrds(j + 1) = "*****"
      Next j
      a(i, 1) = Join(wrds)
    Next i
    .Value = a
  End With
End Sub

 

[Peter_SSs]

Another option

Fluff, a couple of issues to consider

a) blank cells
b) values like "Herr Kerr is not in today but Herr Gruff is"

 

[Fluff]

Two very good points Peter.
Amended code

Sub ReplaceNextWord()
   Dim Ary As Variant, x As Variant, v As Variant, w As Variant
   Dim i As Long, j As Long
   Ary = Range("C1", Range("C" & Rows.count).End(xlUp))
   For i = 2 To UBound(Ary)
      If Not IsEmpty(Ary(i, 1)) Then
         x = Split(Ary(i, 1), " ")
         For j = 0 To UBound(x)
            If LCase(x(j)) = "herr" Or LCase(x(j)) = "frau" Then
               x(j) = String(Len(x(j)), "*")
               Ary(i, 1) = Join(x, " ")
            End If
         Next j
      End If
   Next i
   Range("C1").Resize(UBound(Ary)).Value = Application.Index(Ary, 0, 1)
End Sub

 

[JaspeR_Etzi]

I'm sure this could be done more elegantly but it works. Sub checks for Herr and Frau, returns the first and last char number of these words and replaces the names with asterisks. Make sure to edit the ranges to suit your WB.

Sub repl()s = 1
start:
charnHerr = InStr(s, ThisWorkbook.Sheets(1).Range("A1").Value, "Herr")
charnFrau = InStr(s, ThisWorkbook.Sheets(1).Range("A1").Value, "Frau")


If charnHerr = "0" And charnFrau = "0" Then Exit Sub


If charnHerr > charnFrau And Not charnFrau = "0" Then
GoTo Frau
Else
GoTo Herr
End If


Herr:
If charnHerr <> "0" Then
For Each cell In ThisWorkbook.Sheets(1).Range("A1")
    For i = charnHerr + 5 To Len(cell)
        Select Case Asc(Mid(cell.Value, i, 1))
            Case 48 To 57, 65 To 90, 79 To 122
            Case Else
            rv = Mid(cell.Value, charnHerr + 5, i - charnHerr - 5)
            replaceValue = Replace(cell, rv, "*****")
            cell.Value = replaceValue
            s = charnHerr + 5
            GoTo start
        End Select
    Next i
Next


End If


Frau:
If charnFrau <> "0" Then
For Each cell In ThisWorkbook.Sheets(1).Range("A1")
    For i = charnFrau + 5 To Len(cell)
        Select Case Asc(Mid(cell.Value, i, 1))
            Case 48 To 57, 65 To 90, 79 To 122
            Case Else
            rv = Mid(cell.Value, charnFrau + 5, i - charnFrau - 5)
            replaceValue = Replace(cell, rv, "*****")
            cell.Value = replaceValue
            s = charnFrau + 5
            GoTo start
        End Select
    Next i
Next


End If
End Sub

First of all, thank you for your time and your posted answer.
Your code doesn't seem to work for me even when I edit the range properly.
Since I am new to this kind of stuff I can only assume you looked for the word "herr" and "frau" in the collumn of the range that I providet and whenever it matched it tried to replace the very next word?
Here is an example of what the spreadsheets looks like:
A B C D E F
--------------+----------------+-------------------------------+--------------+------------+-------------
row number | bank | answer | category a | category b | category c
--------------+----------------+-------------------------------+--------------+------------+-------------
1 |example bank | I really dislike Herr Schuh | 1 | 1 | 1
--------------+----------------+-------------------------------+--------------+------------+-------------
2 |example bank | **** this Frau Hildebert! | 1 | 1 | 1
--------------+----------------+-------------------------------+--------------+------------+-------------
3 |example bank | Whats up with Herr Olgierd?| 1 | 1 | 1
--------------+----------------+-------------------------------+--------------+------------+-------------
and so on...

I am only trying to censor the names from the 3rd row.

 

[JaspeR_Etzi]

First of all, thank you for your time and your posted answer.
Your code doesn't seem to work for me even when I edit the range properly.
Since I am new to this kind of stuff I can only assume you looked for the word "herr" and "frau" in the collumn of the range that I providet and whenever it matched it tried to replace the very next word?
Here is an example of what the spreadsheets looks like:
A B C D E F
--------------+----------------+-------------------------------+--------------+------------+-------------
row number | bank | answer | category a | category b | category c
--------------+----------------+-------------------------------+--------------+------------+-------------
1 |example bank | I really dislike Herr Schuh | 1 | 1 | 1
--------------+----------------+-------------------------------+--------------+------------+-------------
2 |example bank | **** this Frau Hildebert! | 1 | 1 | 1
--------------+----------------+-------------------------------+--------------+------------+-------------
3 |example bank | Whats up with Herr Olgierd?| 1 | 1 | 1
--------------+----------------+-------------------------------+--------------+------------+-------------
and so on...

I am only trying to censor the names from the 3rd row.

Just realized you cant use that many spaces in the post in a row, I am sorry and hope you still understand what I mean.