Streamlining function that gets the length of each value

The code works well but before I added sections (13) and (14), it ran in 6 minutes and now runs in 16 minutes. If there is a way to streamline this to cut down the runtime, that would be extraordinary.

Main part of code grabs values from under the header 'CUTTING TOOL' in various opening files in a designated folder. They are then printed to the workbook with code where all the information is printed to, StartSht, and the function alters the output information so that TL- has exactly 6 numbers following it and CT- has 4, plus an extra 2 if there is a "-" after the four numbers (ie CT-0081-01). If less than the specified length, 0s are added immediately after the "-". If greater than the specific length, 0s are deleted immediately after the "-".

With WB
        For Each ws In .Worksheets
'(3)
'find CUTTING TOOL on the source sheet
If Not ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues) Is Nothing Then
Set hc = ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues)
    Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
    If dict.count > 0 Then
'add the values to the master list, column 3
        Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0)
        d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
    Else
        'if no items are under the CUTTING TOOL header
        StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0) = "  "
    End If

    For k = 2 To StartSht.Range("C2").End(xlDown).Row
        ret = ""
        str = StartSht.Range("C" & k).Value

        ret = ExtractNumberWithLeadingZeroes(str, "TL", 6)
        If ret <> "" Then
            StartSht.Range("C" & k).Value = "TL-" & ret
        Else           
            'for CT numbers
            ret = ExtractNumberWithLeadingZeroes(str, "CT", 4)
            If ret <> "" Then
                StartSht.Range("C" & k).Value = "CT-" & ret
            End If

        End If
Next k
...
...
...

Functio

Without seeing the rest of the code that makes up your first block of code this is tricky to answer. From helping you with this on SO I remember that you are looping through many files and extracting values from them. I think the problem lies in this code:

For k = 2 To StartSht.Range("C2").End(xlDown).Row
    ret = ""
    str = StartSht.Range("C" & k).Value

    ret = ExtractNumberWithLeadingZeroes(str, "TL", 6)
    If ret <> "" Then
        StartSht.Range("C" & k).Value = "TL-" & ret
    Else           
        'for CT numbers
        ret = ExtractNumberWithLeadingZeroes(str, "CT", 4)
        If ret <> "" Then
            StartSht.Range("C" & k).Value = "CT-" & ret
        End If

    End If
Next k

which actually exists within the loop that opens each file and extracts the values. Inside the For k = 2 ... loop in the block posted just above, you always start at row 2 and read down the whole data. Do you see the problem with this? Each time you paste data from another file, you start again at row 2 on StartSht and read downwards. This means you are running the ExtractNumberWithLeadingZeroes function over the same cells again and again. The first time it produces the number you need but then every subsequent time it is taking in this number, working through it and then giving you back the same result.

You have two options: 1) extract the For k = 2 ... loop from inside the loop that finds the files and just run it afterwards, or 2) use a variable to keep track of the row number at which the new data starts and start the loop there For k = newDataRowNum To StartSht.Range("C2").End(xlDown).Row

StackExchange Code Review Q#95979, answer score: 2