Replace "~" in Cell of Col. A through the cell before

Hello everyone,

i have to replace "~" in column A through the content of cell before which has no "~". I have to process many thousands of dictionary words. For example:


Col. A (before)
long
love
~ly
~one
making ~
be~d
lou
loud
~ly


After running th macro it should give following results:

Col. A (after)
long
love
lovely
loveone
making love
beloved
lou
loud
loudly

Thank you very much for each help in advance.

Please also refer to example excel file!!

One approach using Evaluate

Public Sub Example()
With Range(Cells(2, "A"), Cells(Rows.Count, "A").End(xlUp))
    .Value = Evaluate("IF(ROW(" & .Address & "),SUBSTITUTE(" & .Address & ",""~""," & .Offset(-1).Address & "))")
End With
End Sub

EDIT: ignore the above, I failed to notice consecutive ~ requirement

Just on an aside - do you definitively need VBA, ie based on your sample

E2:
=IF(ISERR(SEARCH("~~",$A2)),$A2,SUBSTITUTE($A2,"~",LOOKUP(2,1/(ISERR(SEARCH("~~",$A$1:$A1))),$A$1:$A1)))

copied down should give you your results, no ?

Hello Wali,

This macro has been added to the attached workbook. I have run it, and from what I seems to work correctly. But, you need to be the judge.

Sub CompoundWords()

  Dim Data() As Variant
  Dim I As Long
  Dim R As Long
  Dim RegExp As Object
  Dim Rng As Range
  Dim RngEnd As Range
  Dim RootWord As String
  Dim S As String
  Dim Wks As Worksheet
  
    Set RegExp = CreateObject("VBScript.RegExp")
    RegExp.Global = True
    RegExp.Pattern = "(~)"
    
      Set Wks = ActiveSheet
      
      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
      
        RootWord = Data(1, 1)
        For I = 2 To UBound(Data, 1)
          S = Data(I, 1)
          If RegExp.Test(S) = True Then
             Data(I, 1) = RegExp.Replace(S, RootWord)
          Else
             RootWord = S
          End If
        Next I
      
      Rng.Value = Data
      
    Set RegExp = Nothing
    
End Sub

Wali,

If your list starts in A1, DO's formula goes in B2 and is copied down from there. It works perfectly.

May be because i am using German version of Excel.

DO has a link in his sig to function name translations, which should be right up your alley.