get the desired name split in VBA-CodePudding

how can I customize the file name that uses the "-" sign so that it doesn't disappear after running the code below indeed in the code below it removes after the "-" but there is something that I don't need to remove. So I want the result to be like in the screenshot that I marked in yellow. Can I make an exception? Thanks

Sub GetFileName2()
    Dim lr As Long
    Dim Rng As Range
    Dim arr1() As String
    Dim arr2() As String
    Dim arr3() As String
    Application.ScreenUpdating = False
'   Find last row in column A with data
    Sheets("Master").Select
    lr = Cells(Rows.Count, "A").End(xlUp).Row
'   Pre-format column C for text
    Columns("C:C").NumberFormat = "@"
'   Loop through every cell in column A starting in row 2
    For Each Rng In Range("A2:A" & lr)
        arr1 = Split(Rng.Value, "\")
        Rng.Offset(0, 1).Value = arr1(UBound(arr1, 1))
        arr2 = Split(arr1(UBound(arr1, 1)), "(")
        arr3 = Split(arr2(0), "-")
'       If first member of array is blank, choose the second
        If Left(arr2(0), 1) = "-" Then
            Rng.Offset(0, 2).Value = Replace(arr2(0), ".jpg", "")
        Else
            Rng.Offset(0, 2).Value = Replace(arr3(0), ".jpg", "")
        End If
    Next Rng
    Application.ScreenUpdating = True
End Sub

CodePudding user response：

I've added Regular Expressions to your code (pattern works for your sample data). The "^(\d -\d -\d |[^-\)\(] )" matches digits-digits-digits or any character except/upto "-", "(", ")" ( means 1 or more). Regex can be really useful when data has multiple patterns (in your case just 2).

Sub GetFileName2()
    Dim lr As Long
    Dim Rng As Range
    Application.ScreenUpdating = False
'   Find last row in column A with data
    Sheets("Master").Select
    lr = Cells(Rows.Count, "A").End(xlUp).Row
'   Pre-format column C for text
    Columns("C:C").NumberFormat = "@"
'   Loop through every cell in column A starting in row 2
    
    'regex
    Dim re As Object
    Dim filename As String
    Set re = CreateObject("vbscript.RegExp")
    re.IgnoreCase = True
    re.Pattern = "^(\d -\d -\d |[^-\)\(] )"
    
    For Each Rng In Range("A2:A" & lr)
        filename = Rng.Value
        filename = Mid$(filename, InStrRev(filename, "\")   1)
        Rng.Offset(0, 1).Value = filename
        
        filename = Trim(Replace(filename, ".jpg", vbNullString))
        With re.Execute(filename)
            If .Count > 0 Then
                Rng.Offset(0, 2).Value = .Item(0)
            End If
        End With
    Next Rng
    
    Application.ScreenUpdating = True
End Sub

I've used your code as a basis here which is not perfect, accesses worksheet multiple times. I'd go for reading data into 2d array (all 3 columns) -> do the filename and code extraction -> write back the entire array to the worksheet.

CodePudding user response：

Please, try the next function:

Function correctJpgName(x As String)
    Dim arr, arrJ
    If InStr(x, "(") > 0 Then
        arr = Split(x, "("): arrJ = Split(arr(UBound(arr)), ".")
        correctJpgName = arr(0) & "." & arrJ(UBound(arrJ))
    Else
        arr = Split(x, "-"): arrJ = Split(arr(UBound(arr)), ".")
        If UBound(arr) = 2 Then
            correctJpgName = x
        ElseIf UBound(arr) < 2 Then
            arr(UBound(arr)) = "." & arrJ(UBound(arrJ))
            correctJpgName = Replace(Join(arr), " ", "")
        Else
            arr(UBound(arr) - 1) = arr(UBound(arr) - 1) & "." & arrJ(UBound(arrJ))
            arr(UBound(arr)) = "#@$%"      'make the last element imposible to be matched with another one
            arr = filter(arr, "#@$%", False) 'eliminate the last aray element
            correctJpgName = Join(arr, "-")
        End If
    End If
End Function

It can be tried in the next way:

Sub TestcorrectJpgName()
  Dim x As String
  x = "01-03-04-d.jpg"
  x = "01-03-05.jpg"
  x = "TC51-1.png"
  x = "TC52(1).png"
  Debug.Print correctJpgName(x)
End Sub

Please, comment line by line from bottom up and see the result.

Then, to process all column it is faster to place the range in an array, process it in memory and drop the result at the end, at once.