Selected Answer
Fida
I can't think of a non-VBA method to acheive what you want.
Normally the Forum is limited to Q&A and users shouldn't specify what becomes a mini-project (but you got lucky this once!).
In the attached revised, file I've added the code below (with extensive comments) in Module 2. It needs to be run with macros-enabled (look on the internet to see how).
If you select the worksheet GFX, that contains the sample you provived (with combined data in column I). Press key combination Ctrl + Shift + J and the code below will run, asking you questions, extracting the connector detail and telling you of problems (see below):
Sub ExtractConnectors()
'
' Custom code to extract connector details and ignore other texts
' Created by John_Ru (TeachExcel)
' Supplied as seen, the author accepts no liabilities for errors or data loss caused through use
' Keyboard Shortcut: Ctrl+Shift+J
'
Dim NumCol
Dim Inpt As String, Outpt As String, DeLim As String
Dim Rw As Long, LstRw As Long, n As Long, p As Long
Dim Chrctr As String, TempArray As Variant
Dim OutArray As Variant ' array for <= 3 * connectors/statuses and total
Dim IgnoreArray As Variant ' for array of unwanted text entries
Dim StatusArray As Variant ' for array of all status entries
Dim ConnPos As Long, StatusPos As Long, Overs As String
' set delimiter character
DeLim = "|"
' set entries to ignore
IgnoreArray = Array("", "1", "+1", "2", "3", "EV", "EVSEs", "connector", "connector1", "connector2", "connector3")
' set strings used as status (added missing items found)
StatusArray = Array("available", "charging", "unknown", "suspended", "suspended EV", "finishing", "faulted", "preparing", "unavailable")
' ask user where combined text data is
NumCol = InputBox("Type the letter of the column where connector data is combined (e.g. A)" _
& vbCr & vbCr & "(7 columns will be inserted to its right)", _
"Extract connectors from combined text", "I")
If NumCol = "" Then Exit Sub
' handle numbers entered
If IsNumeric(NumCol) Then
r = MsgBox("Column " & NumCol & "?" & _
" Do you mean column " & Split(Cells(1, CInt(NumCol)).Address, "$")(1) & "?", _
vbYesNo)
If r = vbNo Then Exit Sub
' save as column number
NumCol = CInt(NumCol)
Else
' convert to column number
NumCol = Range(NumCol & "1").Column
End If
' determine last used row in A (column 1)
LstRw = Cells(Rows.Count, NumCol).End(xlUp).Row
' add 7 new (yellow) columns to right for results
Cells(1, NumCol + 1).Resize(1, 7).EntireColumn.Insert
With Cells(1, NumCol + 1).Resize(1, 7).EntireColumn
.Interior.Color = vbYellow
.WrapText = False
End With
' loop down rows
For Rw = 2 To LstRw
Inpt = Cells(Rw, NumCol).Text
Outpt = ""
Prt = ""
Frst = False
' loop through cells
For n = 1 To Len(Inpt)
' look at nth character in strin
Chrctr = Mid(Inpt, n, 1)
' if it's a space...
If Asc(Chrctr) = 32 Then
If Frst = True Then
' ... and first since text end, add delimiter to output string
Frst = False
Outpt = Outpt + DeLim
Else
' otherwise ignore it
Frst = False
End If
Else
' if not a space, reset the First(space) flag
Frst = True
' and add character to output string
Outpt = Outpt & Chrctr
End If
Next n
' split remainder into an array
TempArray = Split(Outpt, DeLim)
' compare that to Ignore and Status arrays
' first, reset output position pointers
ConnPos = 1
StatusPos = 2
' clear output array (don't preserve contents)
ReDim OutArray(1 To 7)
' loop through array
For p = LBound(TempArray, 1) To UBound(TempArray, 1)
'check ignore words
For n = LBound(IgnoreArray, 1) To UBound(IgnoreArray, 1)
' if a (case-insensitive) Ignore term, set entry to ""
If LCase(TempArray(p)) = LCase(IgnoreArray(n)) Then
TempArray(p) = ""
Exit For
End If
Next n
'if not...
If TempArray(p) <> "" Then
' ..., check is it's a status
For n = LBound(StatusArray, 1) To UBound(StatusArray, 1)
' if a (case-insensitive) Status, write to output and set entry to ""
If LCase(TempArray(p)) = LCase(StatusArray(n)) Then
' write status then increment pointer (or record error)
OutArray(StatusPos) = TempArray(p)
If StatusPos <= 6 Then
StatusPos = StatusPos + 2
Else
Overs = Overs & Rw & ", "
Exit For
End If
' increment total
OutArray(7) = OutArray(7) + 1
TempArray(p) = ""
Exit For
End If
Next n
End If
'if not ignored or status, assume it's a connector
If TempArray(p) <> "" Then
' write connector name then increment pointer (or record/highlight error)
OutArray(ConnPos) = TempArray(p)
If ConnPos <= 5 Then
ConnPos = ConnPos + 2
Else
' record row
Overs = Overs & Rw & ", "
' set cell and extract to red then select
With Range(Cells(Rw, NumCol), Cells(Rw, NumCol + 7))
.Interior.Color = vbRed
.Select
End With
Exit For
End If
End If
Next p
' write connectors + status to row, total at end
Range(Cells(Rw, NumCol + 1), Cells(Rw, NumCol + 7)) = OutArray
Next Rw
' write headers and autofit results
With Range(Cells(1, NumCol + 1), Cells(1, NumCol + 7))
.Value = Array("EVSE 1", "Connector 1 Status", _
"EVSE 2", "Connector 2 Status", _
"EVSE 3", "Connector 3 Status", _
"Total Connectors")
.EntireColumn.AutoFit
End With
' tell user
MsgBox "Connectors extracted to right of column " & Split(Cells(1, CInt(NumCol)).Address, "$")(1) & " (filled yellow)"
' warn user if errors found
If Overs <> "" Then r = MsgBox("Problem- more than 3 connectors in these rows: " & Overs & "(in red, last row cell/extract selected)", vbExclamation, "Manual extraction of data needed!")
End Sub
If you state the correct column letter (I in the attached file, but could be another within other extracts and it will check if you enter a number instead), it will add 7 yellow columns to the right and extract data. The Total Connectors figure in the rightmost is a correct count of Status entries, not connector names (unless there's more than the maximum 3 you said...)
Currently it will show errors for rows 509 and 510- where there are more than 3 status entries in the combined text. Not sure what you do if there are more than 3 but over to you!
The discussion on your question missed some information but I corrected that in the lines beow (missing items in bold):
' set entries to ignore
IgnoreArray = Array("", "1", "+1", "2", "3", "EV","EVSEs", "connector", "connector1", "connector2", "connector3")
' set strings used as status (added missing items found)
StatusArray = Array("available", "charging", "unknown", "suspended", "suspended EV", "finishing", "faulted", "preparing", "unavailable")
Revision 08 July 2023 (added "EV" to IgnoreArray, "suspended to StatusArray to above and full code; attached a revised file ...v0_b.xlsm)
These lines are critical to "filtering"/ text extraction done by the code (and you may need to adjust them in future) or it might identify other texts as connector names.
I suspect it does in a second or so what would take an hour or more manually. All you have to do is check it worked well, correct any errors, adjust the formatting and delete the source column (if necessary).
Hope this works well for you (it took some effort from me!).If so, please mark this Answer as Selected
