How to delete part of data in a cell with VBA

[Ingemar]

Hello,

I am a new member of MrExcel. I am trying to find a way, using macro, to copy certain part of text in a source cell to another destination cell and then delete the copied part from the original cell but leaving the rest of text in the source cell unmodified.

In cell A1 I have content like this;
QTO-B1C0524,QTO-B1C0424,QTO-B1C0224,QCO-U200264,JDO-U019300,CDO-C007768,

By using an InputBox I would like to choose what part to copy from cell A1 like QTO-. This shall copy all text strings beginning with QTO- up to the comma. which is the separator.

In cell B1 I would like to paste copied parts from cell A1 like "QTO-B1C0524,QTO-B1C0424,QTO-B1C0224,


Cell A1 shall then be like QCO-U200264,JDO-U019300,CDO-C007768.

I am grateful for any help.

Kind regards

Ingemar

 

[Rick Rothstein]

I believe this macro will do what you want...

Sub GetPartialText()
  Dim R As Long, X As Long
  Dim Data As Variant, Result As Variant
  Dim Answer As String, Words() As String
  Answer = InputBox("What text did you want to search for?")
  If Len(Trim(Answer)) Then
    Data = Range("A1", Cells(Rows.Count, "A").End(xlUp))
    ReDim Result(1 To UBound(Data), 1 To 2)
    For R = 1 To UBound(Data)
      Words = Split(Data(R, 1), ",")
      For X = 0 To UBound(Words)
        If InStr(1, Words(X), Answer, vbTextCompare) Then
          Result(R, 2) = Result(R, 2) & "," & Words(X)
        Else
          Result(R, 1) = Result(R, 1) & "," & Words(X)
        End If
      Next
      Result(R, 1) = Mid(Result(R, 1), 2)
      Result(R, 2) = Mid(Result(R, 2), 2)
    Next
    Range("A1").Resize(UBound(Result), 2) = Result
  End If
End Sub

 

[Marcelo Branco]

Or this UDF (User Defined Function)

Function GetText(s As String) As String
    Dim strInput As String, Spl As Variant, i As Long
    
    strInput = InputBox("What text did you want to search for?")
    If Len(strInput) Then
        Spl = Split(Application.Trim(s), ",")
        For i = LBound(Spl) To UBound(Spl)
            If UCase(Left(Spl(i), Len(strInput))) <> UCase(strInput) Then Spl(i) = " "
        Next i
        GetText = Replace(Application.Trim(Join(Spl)), " ", ",")
    End If
End Function

Assuming the original text in A2 use this formula in the destination cell
=GetText(A2)

M.

 

[Rick Rothstein]

Or this UDF (User Defined Function)

Function GetText(s As String) As String
    Dim strInput As String, Spl As Variant, i As Long
    
    strInput = InputBox("What text did you want to search for?")
    If Len(strInput) Then
        Spl = Split(Application.Trim(s), ",")
        For i = LBound(Spl) To UBound(Spl)
            If UCase(Left(Spl(i), Len(strInput))) <> UCase(strInput) Then Spl(i) = " "
        Next i
        GetText = Replace(Application.Trim(Join(Spl)), " ", ",")
    End If
End Function

Assuming the original text in A2 use this formula in the destination cell
=GetText(A2)
.

The OP wanted to delete the results in Column B from the original data in Column A... a UDF cannot do that. Here is what the OP posted...

I am trying to find a way, using macro, to copy certain part of text in a source cell to another destination cell and then delete the copied part from the original cell but leaving the rest of text in the source cell unmodified.

 

[Marcelo Branco]

The OP wanted to delete the results in Column B from the original data in Column A... a UDF cannot do that. Here is what the OP posted...

oops...i had not noticed the "...and then delete...."

M.

 

[Ingemar]

Hello Rick,

Thank you VERY much for the help. The code works fine. However, If I run the macro a second time, it will overwrite the content in the destination cell B1. I have to find a solution to add the values from the second run instead of overwrite. Anyway, again. THANK YOU VERY MUCH.

Kind regards

Ingemar