VBA to extract text

drchakku 

To achieve the desired extraction and splitting of data in Excel using VBA according to the conditions you specified, you can use the following code:

Vba code is untested and is only a example, please backup your file first.

Sub ExtractData()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim cellValue As String
    Dim splitArray() As String
    
    'Assuming data is in Sheet1, adjust if needed
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    'Find the last row with data in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    'Loop through each row from bottom to top
    For i = lastRow To 1 Step -1
        cellValue = Trim(ws.Cells(i, 1).Value)
        
        'Condition 1: Delete rows that don’t start with A or a
        If Not (Left(cellValue, 1) Like "[Aa]") Then
            ws.Rows(i).Delete
            Continue For 'Skip to next iteration
        End If
        
        'Condition 2: Split if there is both * and (
        If InStr(cellValue, "*") > 0 And InStr(cellValue, "(") > 0 Then
            splitArray = Split(cellValue, "*")
            ws.Cells(i, 2).Value = splitArray(0)
            ws.Cells(i, 3).Value = Mid(splitArray(1), 1, InStr(splitArray(1), "(") - 1)
        ElseIf InStr(cellValue, "*") > 0 And InStr(cellValue, "(") = 0 Then
            'Condition 3: Split if there is a * and no (
            splitArray = Split(cellValue, "*")
            ws.Cells(i, 2).Value = splitArray(0)
            ws.Cells(i, 3).Value = Mid(splitArray(1), 1)
        ElseIf InStr(cellValue, "*") = 0 And InStr(cellValue, "(") = 0 Then
            'Condition 4: Split if there is no * and no (
            lastNum = GetLastNumericIndex(cellValue)
            ws.Cells(i, 2).Value = Left(cellValue, lastNum)
            ws.Cells(i, 3).Value = Mid(cellValue, lastNum + 1)
        ElseIf InStr(cellValue, "*") = 0 And InStr(cellValue, "(") > 0 Then
            'Condition 5: Split if there is only (
            lastNum = GetLastNumericIndex(cellValue)
            ws.Cells(i, 2).Value = Left(cellValue, lastNum)
            ws.Cells(i, 3).Value = Mid(cellValue, lastNum)
        End If
    Next i
End Sub

Function GetLastNumericIndex(ByVal str As String) As Long
    Dim i As Long
    For i = Len(str) To 1 Step -1
        If IsNumeric(Mid(str, i, 1)) Then
            GetLastNumericIndex = i
            Exit Function
        End If
    Next i
End Function

This VBA code will perform the following tasks:

1. Delete rows that do not start with "A" or "a".
2. Split data based on conditions mentioned.
3. Utilizes a helper function GetLastNumericIndex to find the last numerical index in a string.

Make sure to adjust the worksheet name ("Sheet1") according to your actual sheet name. Additionally, test this code on a copy of your data to ensure it behaves as expected before applying it to your actual dataset. The text, steps and the code were created with the help of AI.

My answers are voluntary and without guarantee!

Hope this will help you.

Was the answer useful? Mark as best response and Like it!

This will help all forum participants.