CODEWITHSUNDEEP
vbaexcel
chupeman
chupeman

Reputation: 1115

VBA to find string in cell and copy to different cell

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.

enter image description here

Upvotes: 1

Views: 2345

Answers (2)

Erik Emilio Flores Delfin
Erik Emilio Flores Delfin

Reputation: 54

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

Upvotes: 0

Amorpheuses
Amorpheuses

Reputation: 1423

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".

Upvotes: 1

Related Questions