return the value before / char Vba macro

Viewed 36

I have many names some of them has / char and some of them without so I need to copy the names unit the / to a new column

my data not limited more than 300 what I mean not a specific range .. sometimes more sometimes less

I try this code but not work for all the items and not so good can please give any suggestions

Dim str1 As String
Dim str2 As String



str1 = Range("B2").Value
x = 1
Do Until str2 = "/"
If x = Len(str1) + 2 Then GoTo OUT
str2 = Mid(str1, x, 1)
x = x + 1
Loop
OUT:
Range("E2").Value = Left(str1, x - 2)
End Sub

Example of data

1 Answers

Split Cells

  • This can be done in various ways much more efficiently as mentioned in the comments.
  • This is an introductory code that illustrates various subjects:
    • use Options Explicit (declare all variables),
    • use constants,
    • calculate the last 'occupied' row in a column,
    • use a For...Next Loop,
    • use Range.Cells,
    • and use text functions like Instr, Trim, Left, and Right.
  • '* indicates the only differences between the two codes. To simplify, you can copy both lines from the second to the first code appropriately.

The Code

Option Explicit

Sub getName()
    
    Const FirstRow As Long = 2
    Const Delimiter As String = "/"
    
    Dim LastRow As Long: LastRow = Cells(Rows.Count, "B").End(xlUp).Row
    
    Dim sString As String
    Dim Pos As Long
    Dim i As Long
    
    For i = FirstRow To LastRow
        sString = Cells(i, "B").Value
        Pos = InStr(1, sString, Delimiter)
        If Pos > 0 Then
            Cells(i, "E") = Trim(Left(sString, Pos - 1)) '*
        Else
            Cells(i, "E") = Trim(sString) '*
        End If
    Next i
    
End Sub

Sub getLastName()
    
    Const FirstRow As Long = 2
    Const Delimiter As String = "/"
    
    Dim LastRow As Long: LastRow = Cells(Rows.Count, "B").End(xlUp).Row
    
    Dim sString As String
    Dim Pos As Long
    Dim i As Long
    
    For i = FirstRow To LastRow
        sString = CStr(Cells(i, "B").Value)
        Pos = InStr(1, sString, Delimiter)
        If Pos > 0 Then
            Cells(i, "F") = Trim(Right(sString, Len(sString) - Pos)) '*
        Else
            Cells(i, "F") = "" '*
        End If
    Next i
    
End Sub
Related