Excel VBA:  retain values on a column based on string with 2 modes

Option Explicit

Sub Prefix_Retention()
    
    Dim strIO As String
    Dim lngLastRow As Long
    Dim lngRow As Long
    Dim intPos As Integer
    Dim strPrefix As String
    Dim strColInput As String
    Dim strColOutput As String
    Dim intPrefixLen As Integer
    Dim strMode As String
    
    On Error GoTo Error_Routine
    
    strIO = InputBox("Please enter the input and output columns separated by a colon for the data in the form 'InputColum:OutputColumn'", "Choose Columns", "A:B")

    strColInput = Split(strIO, ":")(0)
    strColOutput = Split(strIO, ":")(1)

    If strColInput = vbNullString Or strColOutput = vbNullString Then
        MsgBox "Unable to proceed, please properly report required information", vbCritical
        Exit Sub
    End If
    
    If IsNumeric(strColInput) Then
        strColInput = Split(Cells(1, CInt(strColInput)).Address, "$")(1)
    End If
    
    If IsNumeric(strColOutput) Then
        strColOutput = Split(Cells(1, CInt(strColOutput)).Address, "$")(1)
    End If
    
    lngLastRow = Range(strColInput & "1048576").End(xlUp).Row
    If lngLastRow = 1 Then
        MsgBox "The column you selected as the input column does not contain any data", vbCritical
        Exit Sub
    End If
    
    strPrefix = InputBox("Please enter the starting character(s) of the data that you want to retain.", "Choose Prefix")
    If strPrefix = vbNullString Then
        MsgBox "Unable to proceed, please properly report required information", vbCritical
        Exit Sub
    End If
    intPrefixLen = Len(strPrefix)

    strMode = InputBox("Please enter the scanning mode (R=Right to left, L=Left to right", "Choose Mode")
    If strMode = vbNullString Then
        MsgBox "Unable to proceed, please properly report required information", vbCritical
        Exit Sub
    End If

    ' Validate input
    strMode = UCase(strMode)
    If strMode <> "R" And strMode <> "L" Then
        MsgBox "Unable to proceed, please properly report required information", vbCritical
        Exit Sub
    End If

    For lngRow = 2 To lngLastRow
        intPos = InStr(1, UCase(Cells(lngRow, strColInput).Value), UCase(strPrefix))
        If intPos > 0 Then
            If strMode = "R" Then
                Cells(lngRow, strColOutput).Value = Trim(Mid$(Cells(lngRow, strColInput).Value, intPos))
            Else
                Cells(lngRow, strColOutput).Value = Trim(Mid$(Cells(lngRow, strColInput).Value, 1, intPos + intPrefixLen - 1))
            End If
        End If
    Next

    Exit Sub

Error_Routine:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Prefix_Retention of Module Module1"
    
End Sub

Select all Open in new window