Solved: Selecting part of a cell's contents

[AleemAM123]

Hi Everyone,

I need some help with the attached spreadsheet. I need to extract part of the contents of columns B and C between the text "'PAR(PNT(" and the first exclamation mark , e.g. cell B9 has the text "'PAR(PNT(Column.98!Connections.X23,Column.98!Connections.Y23))" I need to extract the "Column.98" while column C has "'PAR(PNT(Instrument Master.1677!Connections.X2,Instrument Master.1677!Connections.Y2))" I need to get the "Instrument Master.1677".

Can anyone help?

[GTO]

Greetings Aleem,

In this example, I just went thru the first column (Col B). Now as we are returning the extracted string, what do we do with it? For instance, do you want to place just the returned values so many columns to the right, or ???

Sub ExtractPartial()
Dim _
rCell As Range, _
rRange As Range, _
strExtracted As String, _
intStart As Integer, _
intEnd As Integer
Set rRange = ThisWorkbook.Worksheets("NewTable").Range("B2:B1320")

For Each rCell In rRange
If Not InStr(8, rCell.Value, "(", vbTextCompare) = 0 _
And Not InStr(8, rCell.Value, "!", vbTextCompare) = 0 Then

intStart = InStr(8, rCell.Value, "(", vbTextCompare) + 1
intEnd = InStr(8, rCell.Value, "!", vbTextCompare) - intStart
strExtracted = Mid(rCell.Value, intStart, intEnd)
'// Take a looksee in the Immediate window and see if this is what //
'// you want. //
Debug.Print strExtracted
End If
Next
End Sub



Hope this helps,

Mark

[mikerickson]

The spreadsheet formula
=MID(A1,9,FIND("!",A1&"!")-9)

will do what you want.

If the "PAR(PNT(" isn't always at the start of the string, this version could be used.
=MID(A1,FIND("PAR(PNT(",A1)+8,FIND("!",A1&"!")-FIND("PAR(PNT(",A1)-8)

If the prefix isn't always the same,put "PAR(PNT(" in B1 and
=MID(A1,FIND(B1,A1)+LEN(B1),FIND("!",A1&"!")-FIND(B1,A1)-LEN(B1))

[AleemAM123]

Hi GTO,

That works great, how can I get the output to column K?

[AleemAM123]

Hi Mike,

That first formula works, thanks. And it's better looking than mine
=(RIGHT(LEFT(B2,(SEARCH("!",B2)-1)),(LEN(LEFT(B2,SEARCH("!",B2)-1))-8)))

I shoulda known about find but I didn't know mid.:dunno

[Bob Phillips]

I shoulda known about find but I didn't know mid.:dunno

FIND is no better than SEARCH, it is case-sensitive whereas SEARCH isn't.

[GTO]

Greetings Aleem,

In seeing both your responses, as well as your previous formula solution, I wasn't sure whether you went with Mike's formula or still wanted a code solution. In case a vba solution is still desired, here's two ways:

(Note: As they are almost identical, I commnented the second version only)

Take the stripped data to Cols K and L:
Sub ExtractPartial_OffsetReturn()
Dim _
rCell As Range, _
rRange As Range, _
intStart As Integer, _
intEnd As Integer, _
lngLastRow As Long, _
bLoop As Byte

lngLastRow = Application.WorksheetFunction.Max( _
ThisWorkbook.Worksheets("NewTable").Cells(65536, 2).End(xlUp).Row, _
ThisWorkbook.Worksheets("NewTable").Cells(65536, 3).End(xlUp).Row)

Set rRange = ThisWorkbook.Worksheets("NewTable").Range("B2:B" & lngLastRow)

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

For bLoop = 1 To 2 Step 1

For Each rCell In rRange

If Not InStr(8, rCell.Value, "(", vbTextCompare) = 0 _
And Not InStr(8, rCell.Value, "!", vbTextCompare) = 0 Then

intStart = InStr(8, rCell.Value, "(", vbTextCompare) + 1
intEnd = InStr(8, rCell.Value, "!", vbTextCompare) - intStart
rCell.Offset(ColumnOffset:=9).Value = Mid(rCell.Value, intStart, intEnd)

End If

Next rCell

Set rRange = rRange.Offset(ColumnOffset:=1)

Next bLoop

ThisWorkbook.Worksheets("NewTable").Columns("K:L").AutoFit

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Set rRange = Nothing
End Sub

...OR, strip it in place:
Sub ExtractPartial_StripInPlace()
Dim _
rCell As Range, _
rRange As Range, _
intStart As Integer, _
intEnd As Integer, _
lngLastRow As Long, _
bLoop As Byte

'// As we are only operating on Col's B & C, we'll use the worksheet function MAX //
'// to see which column has values the farthest down, and use this to set the //
'// bottom of our range. //
lngLastRow = Application.WorksheetFunction.Max( _
ThisWorkbook.Worksheets("NewTable").Cells(65536, 2).End(xlUp).Row, _
ThisWorkbook.Worksheets("NewTable").Cells(65536, 3).End(xlUp).Row)

'// Set a reference to our initial range. //
Set rRange = ThisWorkbook.Worksheets("NewTable").Range("B2:B" & lngLastRow)

'// Kill stuff that slows down processing and makes our eyes bleed... //
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

'// Just a cheesy/easy way of going thru the two ranges. //
For bLoop = 1 To 2 Step 1

'// For ea cell in the current range... //
For Each rCell In rRange
'// ... check to make sure the cell doesn't have a different type value (see//
'// B430) and doesn't need stripped, lest InStr may cause us to punch the //
'// computer later... //
If Not InStr(8, rCell.Value, "(", vbTextCompare) = 0 _
And Not InStr(8, rCell.Value, "!", vbTextCompare) = 0 Then
'// See where the tail of the first part ends and the start of the last //
'// part are, then rip the middle out. //
intStart = InStr(8, rCell.Value, "(", vbTextCompare) + 1
intEnd = InStr(8, rCell.Value, "!", vbTextCompare) - intStart
rCell.Value = Mid(rCell.Value, intStart, intEnd)
End If
Next rCell

'// After looping thru our first range, use offset to move the range and hence, //
'// where we plant the second range's return in either example. //
Set rRange = rRange.Offset(ColumnOffset:=1)

Next bLoop

'// Pretty up the return. //
ThisWorkbook.Worksheets("NewTable").Columns("B:C").AutoFit

'// Turn stuff back on, lest we wonder why stuff no longer adds up... and explicitly//
'// release the range object. //
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Set rRange = Nothing
End Sub

Sorry for the delayed response. Two days of insomnia finally caught up, and I crashed and burned...

Have a great day,

Mark

[AleemAM123]

Hi GTO,

No problem, thanks a million. The formulas work great it's just that they leave me having to add some conditional statements in them to clean up the cells but that's no real trouble. I was just interested in the code now to see how it's done.