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

[Radjesh Klauke]

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.

[westconn1]

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

[Radjesh Klauke]

Thanks

Unfortunalety I get type mismatched (13)

pos = InStr(cel, ssrh, vbTextCompare)

This is my 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

[vbfbryce]

Try something like this:

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?

[Radjesh Klauke]

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.

[westconn1]

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

[Radjesh Klauke]

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

    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

...

[Radjesh Klauke]

Did some more thinking and figured it out

For Each cel In ActiveSheet.UsedRange

Did the trick.

Thanks for a the help. Much appreciated. +REP