VBA to find string in cell and copy to different cell

Question

I have data that it's not in a consistent position in the cell, sometimes it has a semicolon, sometimes it is to the right or the left of the semicolon. The end result I'm looking is to have in column B all "students" (defined by not being teacher) and in Column C, all Teachers. If no student or teacher is found, then the corresponding cell should be blank.

Currently I'm doing a text to columns to separate both columns then using the following formulas to have the student and teacher separate:

=IF(SUMPRODUCT(--ISNUMBER(SEARCH({"Arts and Music","Math and Science"},A2)))>0,B2,C2)

=IF(SUMPRODUCT(--ISNUMBER(SEARCH("Teacher",A2)))>0,B2,C2)

I still have to do a manual Find and replace to remove the parenthesis and text and leave only the student/teacher name.

IS there any VBA macro that can help me to get from Column A to my expected result in columns B and C? Thank you.

Yes, the one you write. This isn't a code writing service. Make an effort to write one yourself, and ask a question if you run into a problem. Three are literally dozens (if not hundreds) of existing questions about looping through cells in VBA here that you can use to get started. — Ken White, Apr 04 '17 at 21:54

score 1 · Accepted Answer · edited May 23 '17 at 11:54

You can use regular expressions to do this. See this post on how to enable them in excel.

Sub FindStrAndCopy()
 Dim regEx As New RegExp
 regEx.Pattern = "\s*(\w+)\s*\((.+)\)"

 With Sheets(1):
   Dim arr() As String
   Dim val As String

   Dim i As Integer, j As Integer
   Dim person As String, teachOrSubject As String
   Dim mat As Object

   For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row:
     val = Cells(i, "A").Value
     arr = Split(val, ";")
     For j = 0 To UBound(arr):
       Set mat = regEx.Execute(arr(j))
       If mat.Count = 1 Then
         person = mat(0).SubMatches(0)
         teachOrSubject = mat(0).SubMatches(1)
         If teachOrSubject = "Teacher" Then
           Cells(i, "C").Value = person
         Else
           Cells(i, "B").Value = person
         End If
       End If
     Next
   Next

 End With
End Sub

The macro splits the string on a semicolon and stores either 1 or 2 substrings in the 'arr' array. It then does a regular expression on each one. If the string inside the parenthesis is "Teacher" then the preceding person's name is stored in column "C" otherwise it's a student and the name is stored in column "B".

I know I'm not supposed to say thank you in the comments, but this is great. I was not expecting the solution but this solves my problem perfectly. It's nice to see there is still people willing to help and go the extra mile for others. I always try to do it in areas where I can. Thanks again. — chupeman, Apr 05 '17 at 14:44

score 0 · Answer 2 · answered Apr 05 '17 at 17:38

I create a button that read all the registers you have on column A then put the students on column B then put the Teacher on column C

Check that I used "(Teacher)" to know when a teacher is in the String I used the sheet Called "Sheet1" And I don't use the first row because is the header row.

If you have any question please contact me.

Private Sub CommandButton1_Click()
'---------------------------------Variables-----------------------------
Dim total, i, j As Integer
'--------------Counting the number of the register in column A----------
ThisWorkbook.Sheets("Sheet1").Range("XDM1").Formula = "=COUNTA(A:A)"
total = CInt(ThisWorkbook.Sheets("Sheet1").Range("XDM1").Value)
'---------------------Creating arrays to read the rows------------------
Dim rows(0 To 1000) As String
Dim columnsA() As String
'------------Searching into the rows to find teacher or student---------
For i = 2 To total
    columnsA = Split(ThisWorkbook.Sheets("Sheet1").Range("A" & i).Value, ";")
    first = LBound(columnsA)
    last = UBound(columnsA)
    lenghtOfArray = last - first
    MsgBox lenghOfArray
    For j = 0 To lenghtOfArray
        If InStr(columnsA(j), "(Teacher)") > 0 Then
            MsgBox columnsA(j)
            ThisWorkbook.Sheets("Sheet1").Range("C" & i).Value = columnsA(j)
        Else
            ThisWorkbook.Sheets("Sheet1").Range("B" & i).Value = columnsA(j)
        End If
    Next j
Next i
'--------------------------------Finishing------------------------------
End Sub

VBA to find string in cell and copy to different cell

2 Answers2