Find and Replace within String

[madhuchelliah]

Hello all, i have lot of strings in column A. Range is dynamic. The VBA has to find "A ***" within strings and replace with none. *** may be any value. Basically the word after the "A" has to be replaced along with A.
Example: if the string value is XXX DDD A D ZZZ then the output should be XXX DDD ZZZ.
After replacing with none, keep the first word of string in column A and move the rest of the data to column B. Taking previous output as example (XXX DDD ZZZ), XXX should be in column A and DDD ZZZ in column B
Thank you.

 

[Rick Rothstein]

Hello Rick, i am getting error Subscript out of range in the line "Tmp(1) = Mid(Tmp(1), InStr(Tmp(1), " ") + 1)"

That is because (after seeing your example data posted later in this thread) not every cell has that " A " text string in it (your original post did not make that clear). With this new information, I believe this macro will do what you want...

Sub RemoveAandNextWordThenSplit()
  Dim R As Long, Arr As Variant, Tmp As Variant
  Arr = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  ReDim Preserve Arr(1 To UBound(Arr), 1 To 2)
  For R = 1 To UBound(Arr)
    If Arr(R, 1) Like "* A *" Then
      Tmp = Split(Arr(R, 1), " A ")
      Tmp(1) = Mid(Tmp(1), InStr(Tmp(1), " ") + 1)
      Tmp = Split(Join(Tmp, " "), " ", 2)
    Else
      Tmp = Split(Arr(R, 1), " ", 2)
    End If
    Arr(R, 1) = Tmp(0)
    Arr(R, 2) = Tmp(1)
  Next
  Range("A1").Resize(UBound(Arr), 2) = Arr
End Sub

 

[Peter_SSs]

So here i want to have separate VBAs for both actions.

OK, but note that my code does not replace "A *" with nothing as I think you originally asked. My code replaces it with a tab character. That tab character is then used with Text to Columns to split the required items into their respective columns. The two codes would be

Sub Split_Data_1()
  Dim RX As Object
  Dim a As Variant
  Dim i As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Pattern = "(.+)(\sA\s\S+\s)(.*)"
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      a(i, 1) = RX.Replace(a(i, 1), "$1" & vbTab & "$3")
    Next i
    .Value = a
  End With
End Sub

Sub Split_Data_2()
  Range("A2", Range("A" & Rows.Count).End(xlUp)).TextToColumns , xlDelimited, , , True, False, False, False, False
End Sub

 

[madhuchelliah]

That is because (after seeing your example data posted later in this thread) not every cell has that " A " text string in it (your original post did not make that clear). With this new information, I believe this macro will do what you want...

Sub RemoveAandNextWordThenSplit()
  Dim R As Long, Arr As Variant, Tmp As Variant
  Arr = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  ReDim Preserve Arr(1 To UBound(Arr), 1 To 2)
  For R = 1 To UBound(Arr)
    If Arr(R, 1) Like "* A *" Then
      Tmp = Split(Arr(R, 1), " A ")
      Tmp(1) = Mid(Tmp(1), InStr(Tmp(1), " ") + 1)
      Tmp = Split(Join(Tmp, " "), " ", 2)
    Else
      Tmp = Split(Arr(R, 1), " ", 2)
    End If
    Arr(R, 1) = Tmp(0)
    Arr(R, 2) = Tmp(1)
  Next
  Range("A1").Resize(UBound(Arr), 2) = Arr
End Sub

Hello Rick, it is working fine. Thanks for your time.

 

[madhuchelliah]

OK, but note that my code does not replace "A *" with nothing as I think you originally asked. My code replaces it with a tab character. That tab character is then used with Text to Columns to split the required items into their respective columns. The two codes would be

Sub Split_Data_1()
  Dim RX As Object
  Dim a As Variant
  Dim i As Long
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Pattern = "(.+)(\sA\s\S+\s)(.*)"
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      a(i, 1) = RX.Replace(a(i, 1), "$1" & vbTab & "$3")
    Next i
    .Value = a
  End With
End Sub

Sub Split_Data_2()
  Range("A2", Range("A" & Rows.Count).End(xlUp)).TextToColumns , xlDelimited, , , True, False, False, False, False
End Sub

Pete, it working as expected. Thanks for splitting the VBA. Thanks for your time.

 

[Peter_SSs]

Pete, it working as expected. Thanks for splitting the VBA. Thanks for your time.

You're welcome. Glad we could help.