[RESOLVED] Remve everything in cell after specific full word + word (VBA)

Hi,

I'm in need of a VBA code that removes everything in a cell after a specific word + the word itself in the active sheet and/or selection. Perhaps this can be done in 2 separate codes. (one for full sheet and one for selection)

In the following example we want to remove the "word_to_replace" and everything after that. We are going to search for the word "or":
VBA or VB
VBA OR C#
C# ororor or C++

After executing the code in the current active sheet I want the result to be:

VBA
VBA
C# ororor

Anyone?

Thanks in advance.

Code:

---

ssrch = " or "    ' note spaces
for each cel in selection.cells
  pos = instr(cel, ssrch, vbtextcompare)
  if pos > 0 then cel.value = left(cel, pos -1)
next

---

for whole sheet,
replace selection.cells with activesheet.cells

Thanks ;)

Unfortunalety I get type mismatched (13)

pos = InStr(cel, ssrh, vbTextCompare)

This is my code:

Code:

---

Option Explicit

Private Sub CommandButton1_Click()
    Dim ssearch As String
    Dim cel As Range
    Dim pos As Integer
   
    ssearch = " " & Trim(TextBox1.Text) & " "  ' note spaces
    For Each cel In Selection.Cells
        pos = InStr(cel, ssearch, vbTextCompare)
        If pos > 0 Then cel.Value = Left(cel, pos - 1)
    Next
End Sub

---

Try something like this:

Code:

---

For Each c In rng
        pos = InStr(1, c.Value, "or")
    Next

---

The first argument for InStr is "start", so you wouldn't want "cel" there, I don't think.

Pete, am I understanding that correctly, or no?

Code:

---

pos = InStr(1, cel, ssearch, vbTextCompare)

---

seems to work.

There is a small issue left. When using ActiveSheet it also searches in the empty cells, which takes a long time. Any way to avoid that?
Already using application.screenupdating btw.

Code:

---

if not isempty(cel) then
        pos = InStr(1, cel, ssearch, vbTextCompare)
        If pos > 0 Then cel.Value = Left(cel, pos - 1)
end if

---

Thanks, but unfortunately it doesn't work. The computer freezes completely and it takes more then 5 hours before it's done...

Code:

---

    Dim ssearch As String
    Dim cel As Range
    Dim pos As Integer

    ssearch = " " & Trim(txt_word.Value) & " "

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For Each cel In Selection.Cells
        If Not IsEmpty(cel) Then
                ...
        End If
    Next

...

---

Did some more thinking and figured it out ;)

Code:

---

For Each cel In ActiveSheet.UsedRange

---

Did the trick.

Thanks for a the help. Much appreciated. +REP