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]

Assuming the "A" is always surrounded by a single space on each side and that your data starts in cell A1, give this macro a try...

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)
    Tmp = Split(Arr(R, 1), " A ")
    Tmp(1) = Mid(Tmp(1), InStr(Tmp(1), " ") + 1)
    Tmp = Split(Join(Tmp, " "), " ", 2)
    Arr(R, 1) = Tmp(0)
    Arr(R, 2) = Tmp(1)
  Next
  Range("A1").Resize(UBound(Arr), 2) = Arr
End Sub

 

[mumps]

Already solved!!

 

[Rick Rothstein]

Already solved!!

Unless your solution uses the same underlying logic (my guess is it doesn't), you should post your code so the OP and future readers of this thread can have a variety of solutions to pick from.

 

[madhuchelliah]

Assuming the "A" is always surrounded by a single space on each side and that your data starts in cell A1, give this macro a try...

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)
    Tmp = Split(Arr(R, 1), " A ")
    Tmp(1) = Mid(Tmp(1), InStr(Tmp(1), " ") + 1)
    Tmp = Split(Join(Tmp, " "), " ", 2)
    Arr(R, 1) = Tmp(0)
    Arr(R, 2) = Tmp(1)
  Next
  Range("A1").Resize(UBound(Arr), 2) = Arr
End Sub

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

 

[Rick Rothstein]

Then I think one of two things maybe be possible... either you have some "spaces" that are not real spaces (perhaps they are non-breaking spaces which usually come from copying data off the web) or you have multiple spaces where your example is showing single spaces. Since we cannot tell from what you have posted so far, I would suggest you upload your workbook with the original data (before running my code against it) to DropBox, mark it for sharing and post the link they give you for your file here so we can look at your exact data. Once we can see that we can modify the code to account for what the problem is.

 

[Peter_SSs]

Another option to try

Sub Split_Data()
  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
    .TextToColumns , xlDelimited, , , True, False, False, False, False
  End With
End Sub

 

[madhuchelliah]

Another option to try

Sub Split_Data()
  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
    .TextToColumns , xlDelimited, , , True, False, False, False, False
  End With
End Sub

Hello Pete, it is working as expected. Could you please split into 2 different VBA's, one for find and replace and another one to move the data of entire column A to B column except first word of column A. Thank you.

 

[Peter_SSs]

it is working as expected.

Good news.

Could you please split into 2 different VBA's, one for find and replace and another one to move the data of entire column A to B column except first word of column A.

That is not clear to me. Can you provide some sample data (say 8-10 rows) and the expected results with XL2BB and explain again in relation to those samples?

 

[madhuchelliah]

Good news.


That is not clear to me. Can you provide some sample data (say 8-10 rows) and the expected results with XL2BB and explain again in relation to those samples?

Peter, initially 2 actions was combined in one VBA. That is Find and Replacing "A *" and moving the data(except first word) from A column to B column. So here i want to have separate VBAs for both actions. In between those 2 actions i have another one to include. So want you to split into 2 different VBAs. Example shown below. Thanks for your efforts.

Book2.xlsm
	A	B	C	D
1	First VBA
2	Input (Column A)	Output (Column A)
3	XXX DDD A D ZZZ	XXX DDD ZZZ
4	XXX DDD D ZZZ	XXX DDD D ZZZ
5	XXX DDD D ZZZ	XXX DDD D ZZZ
6	XXX DDD A D ZZZ	XXX DDD ZZZ
7	XXX DDD D ZZZ	XXX DDD D ZZZ
8	XXX DDD D ZZZ	XXX DDD D ZZZ
9	XXX DDD D ZZZ	XXX DDD D ZZZ
10	XXX DDDD ZZZ	XXX DDDD ZZZ
11	XXX DDD A D ZZZ	XXX DDD ZZZ
12	XXX DDD D ZZZ	XXX DDD D ZZZ
13	XXX DDD D ZZZ	XXX DDD D ZZZ
14	XXX DDD D ZZZ	XXX DDD D ZZZ
15	XXX DDD A D ZZZ	XXX DDD ZZZ
16	XXX DDD A D ZZZ	XXX DDD ZZZ
17
18
19
20	Second VBA
21	Input (Column A) (Output of 1st VBA		Output (Column A)	Output (Column B)
22	XXX DDD ZZZ		XXX	DDD ZZZ
23	XXX DDD D ZZZ		XXX	DDD D ZZZ
24	XXX DDD D ZZZ		XXX	DDD D ZZZ
25	XXX DDD ZZZ		XXX	DDD ZZZ
26	XXX DDD D ZZZ		XXX	DDD D ZZZ
27	XXX DDD D ZZZ		XXX	DDD D ZZZ
28	XXX DDD D ZZZ		XXX	DDD D ZZZ
29	XXX DDDD ZZZ		XXX	DDDD ZZZ
30	XXX DDD ZZZ		XXX	DDD ZZZ
31	XXX DDD D ZZZ		XXX	DDD D ZZZ
32	XXX DDD D ZZZ		XXX	DDD D ZZZ
33	XXX DDD D ZZZ		XXX	DDD D ZZZ
34	XXX DDD ZZZ		XXX	DDD ZZZ
35	XXX DDD ZZZ		XXX	DDD ZZZ
Sheet1 (3)