Given a string I want to extract some text - excel

Question

Given a list of strings, I want to divide the strings into different columns. The strings does not always comes in the same format, so I cannot use the same approach each time. I am trying to put the LC-XXXXXX in column B, then delete the "s" and put the text after the "s" and between the "^" or the "." (whatever the string contains) into column C
I am running a "for loop" for each string in which is saved as an array and looks something like this:
I have use the split, trim and mid commands but with no success.
With Sheets("TELECOM")
.Range("A14", "I305").ClearContents
For Each objFile In objFolder.Files
On Error Resume Next
If InStr(objFile.Name, "LC-9") > 0 And InStr(objFile.Type, "DWG File") > 0 Then
drwn = objFile.Name
.Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here
values = Array(drwn)
Set re = CreateObject("vbscript.regexp")
pattern = "(s\d+)"
For i = LBound(values) To UBound(values)
.Cells(r, 3) = Replace$(drwn, "s", vbNullString)
Next
r = r + 1
End With
Public Function GetId(ByVal re As Object, ByVal s As String, ByVal pattern As String) As String
With re
.Global = True
.MultiLine = True
.IgnoreCase = False '? True if case insensitive
.pattern = pattern
If .test(s) Then
GetId = .Execute(s)(0).SubMatches(0)
End If
End With
End Function
I would like to take the list of stings and put the LC-XXXXX in column B and the sheet number (numbers between the "s" and the "^" or sometimes the ".dwg" or ".pdf") into a column C
NEW EDIT 04/06/2019
New Edit 04/07/2019
Main Code
Sub GetIssued()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim openPos As Integer
Dim closePos As Integer
Dim sh As Object
Dim drwn, SheetNum
Set objFSO = CreateObject("scripting.FileSystemObject")
r = 14
fle = ThisWorkbook.Sheets("Header Info").Range("D11") &
"\Design\Substation\CADD\Working\COMM\"
Set objFolder = objFSO.GetFolder(fle)
Set x1Book = ActiveWorkbook 'Using this Activeworkbook
Set sh = x1Book.Sheets("TELECOM") 'Using this particular sheet
With Sheets("TELECOM")
.Range("A14", "I305").ClearContents
For Each objFile In objFolder.Files
On Error Resume Next
If InStr(objFile.Name, "LC-9") > 0 And InStr(objFile.Type, "DWG
File") > 0 Then 'PEDs, Single Line, Cable and Wiring, Jumper and
Interconnection
.Cells(r, 9) = objFile.Name 'Testing Purposes
drwn = Array(.Cells(r, 9).Value)
.Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the
drawing number and placing it here
'-----------------------------------------------------------
'Trying to Insert InstrMacro here
'------------------------------------------------------------
r = r + 1
ElseIf InStr(objFile.Name, "MC-9") > 0 And InStr(objFile.Type, "DWG File") > 0 Then 'Cable List
.Cells(r, 9) = objFile.Name 'Testing Purposes
drwn = .Cells(r, 9).Value
.Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here
'-----------------------------------------------------------
'Trying to Insert InstrMacro here
'------------------------------------------------------------
r = r + 1
ElseIf InStr(objFile.Name, "BMC-") > 0 And InStr(objFile.Type, "Adobe Acrobat Document") > 0 Then 'Bill of Materials
.Cells(r, 9) = objFile.Name 'Testing Purposes
drwn = .Cells(r, 9).Value
.Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here
'-----------------------------------------------------------
'Trying to Insert InstrMacro here
'------------------------------------------------------------
r = r + 1
ElseIf InStr(objFile.Name, "CSR") > 0 And InStr(objFile.Type, "DWG") > 0 Then 'Single Line Diagram
.Cells(r, 9) = objFile.Name 'Testing Purposes
drwn = .Cells(r, 9).Value
.Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here
'---------------------------------------------------------
'Trying to Insert InstrMacro here
'------------------------------------------------------------
r = r + 1
End If
Next
End With
Range("A13:F305").HorizontalAlignment = xlCenter
Range("A1").Select
End Sub
The marco that I have working can be seen here:
Sub InstrMacro()
Dim openPos As Integer
Dim closePos As Integer
Dim drwn, SheetNum
drwn = Range("E9") ' String to search in the sheet aka: the hot seat
'Performing a test to see if this is a new drawing or not
SheetNum = InStr(drwn, "^")
openPos = InStr(drwn, "s") 'True reguardless of the condition of the drawing
If SheetNum = 0 Then 'Assuming it is a new drawing
closePos = InStr(drwn, ".")
SheetNum = Mid(drwn, openPos + 1, closePos - openPos - 1)
Else
If SheetNum > 0 Then 'Assuming is NOT a new drawing
closePos = InStr(drwn, "^")
SheetNum = Mid(drwn, openPos + 1, closePos - openPos - 1)
End If
End If
Range("G20").Value = SheetNum
End Sub
A picture for this macro can be seen here.
I have tried making a separate macro the runs and can get the sheet number, but it seems that excel is just skipping this step and running through the rest of the program
I would like to put the drawing number in column B and the sheet number in sheet number in column c.

Answer 1

A solution with no loops nor regex
Sub FindIt()
Dim strng As String, iPos As Long
strng= "1sa2sb3s4sd5se"
iPos = InStr(strng, "s")
If iPos > 0 And iPos < Len(strng) Then
If InStr("1234567890", Mid(strng, iPos + 1, 1)) > 0 Then
MsgBox "Found s" & Mid(strng, iPos + 1,1) & " at position " & iPos
End If
End If
End Sub
Which can be easily twicked to limit the number of numeric digits following the “s” character

Answer 2

If it is s followed by a number/numbers, and this pattern only occurs once, you could use regex.
Option Explicit
Public Sub test()
Dim re As Object, pattern As String, values(), i As Long
values = Array("LC-94773s2^003735377.pdf", "LC-94773s2", "LC-93521s1-A^005241446")
Set re = CreateObject("vbscript.regexp")
pattern = "(s\d+)"
For i = LBound(values) To UBound(values)
Debug.Print Replace$(GetId(re, values(i), pattern), "s",vbNullString)
Next
End Sub
Public Function GetId(ByVal re As Object, ByVal s As String, ByVal pattern As String) As String
With re
.Global = True
.MultiLine = True
.IgnoreCase = False '? True if case insensitive
.pattern = pattern
If .test(s) Then
GetId = .Execute(s)(0).SubMatches(0)
Else
GetId = "No match"
End If
End With
End Function
You can vary this pattern, for example, if want start to be LC-9
Public Sub test()
Dim re As Object, pattern As String, values(), i As Long
values = Array("LC-94773s2^003735377.pdf", "LC-94773s2", "LC-93521s1-A^005241446")
Set re = CreateObject("vbscript.regexp")
pattern = "LC-9(.*)(s\d+)"
For i = LBound(values) To UBound(values)
Debug.Print Replace$(GetId(re, values(i), pattern), "s",vbNullString)
Next
End Sub

Answer 3

To see if a string contains a lower case s followed by a numeral:
Sub sTest()
Dim s As String, i As Long
s = "jkuirelkjs6kbco82yhgjbc"
For i = 0 To 9
If InStr(s, "s" & CStr(i)) > 0 Then
MsgBox "I found s" & i & " at position " & InStr(s, "s" & CStr(i))
Exit Sub
End If
Next i
MsgBox "pattern not found"
End Sub

Answer 4

You could try:
Option Explicit
Sub test()
Dim arr As Variant
Dim i As Long
arr = Array("LC-94773s2^003735377.pdf", "LC-94773s2", "Mar", "LC-93521s1-A^005241446")
For i = LBound(arr) To UBound(arr)
If InStr(1, arr(i), "s") Then
Debug.Print Mid(arr(i), InStr(1, arr(i), "s"), 2)
End If
Next i
End Sub