My source code is below

Private Sub Command1_Click()
MsgBox FilterData("0012-1189-4567", 1, "12")
MsgBox FilterData("0012-1189-4567", 3, "126")
End Sub

Private Function FilterData(strDg As String, ipos As Byte, strcut As String) As String
Dim idg() As String
Dim i As Integer
Dim icnt As Integer
Dim icntcut As Integer
Dim icut As Byte
Dim ilen As Byte
Dim tmpStr As String
If Trim(strDg) <> "" Then
idg = Split(strDg, "-")
tmpStr = ""
icnt = 1
icntcut = 0
For i = 0 To UBound(idg)
If InStr(1, strcut, Mid(idg(i), ipos, 1), vbTextCompare) <> 0 And InStr(1, tmpStr, idg(i), vbTextCompare) = 0 Then
If icnt <= 9 Then
tmpStr = tmpStr & Trim(idg(i)) & "-"
Else
tmpStr = tmpStr & Trim(idg(i)) & vbCrLf
icnt = 0
End If
icnt = icnt + 1
icntcut = icntcut + 1
End If
Next
FilterData = tmpStr
Else
FilterData = ""
End If
End Function

How to modify function FilterData to very fast if strdg = "0000-0001-...-9999" (10000 sets)