Converting LEFT and RIGHT with FIND formulas to VBA macros including IFERROR

[1819]

Please could you help with converting the following formulas to produce the same result using VBA macros. (Or even a single macro).

The range I want them to work on is any row in column B with a value.

=LEFT(B2,IFERROR(FIND(" ",B2&" ")-1,LEN(B2)))

=IFERROR(RIGHT(B2,LEN(B2)-FIND(" doc",B2)),"")

Many thanks.

[SamT]

I am not really a formula guy so correct me if I am wrong: The first formula is supposed to return the first full word and the secons the string after the word "doc").

[1819]

I am not really a formula guy so correct me if I am wrong: The first formula is supposed to return the first full word and the secons the string after the word "doc").

Thanks Sam.

Yes, the first formula returns the first word.

The second formula returns the string beginning with (and including) " doc".

Sometimes the target cell doesn't have any words, or only one word. Hence the need to handle errors.

I've attached a demo worksheet to show what I mean. The aim is to split up 2 URLs from one cell. The second will always begin "pic" (not doc in this instance). Essentially I am seeking a VBA solution to create the outcome shown in the sample worksheet being achieved by formulas.

Hope you can help. Many thanks.

[SamT]

Put these two User Defined Functions in one of tre Standard Modules and use them like any Excel Function


Public Function FirstWord(Target As Range) As String
If Len(Target) = 0 Then Exit Function

If InStr(Target, " ") Then
FirstWord = Left(Target, InStr(Target, " ") - 1)
Else
FirstWord = Target
End If
End Function


Public Function LastWord(Target As Range) As String
If Len(Target) = 0 Or InStr(Target, " ") = 0 Then Exit Function

LastWord = Right(Target, (Len(Target) - InStrRev(Target, " ")) + 1)
End Function


Example Formula (per your at6tachment):
Cell F2: "=FirstWord(A2)"
Cell G2: "=LastWord(A2)"

[GTO]

Hi All,

I'm sure my pattern is wretched, but if the addresses are as consistent as shown, maybe (as a UDF also) :



Option Explicit
'
Public Function URL(ByVal Cell As String, FirstWord As Boolean)
Static REX As Object
'
If REX Is Nothing Then
Set REX = CreateObject("VBScript.RegExp")
End If

With REX
.Global = False
.IgnoreCase = True

If FirstWord Then
'If "regular" spaces (CHR(32)
'.Pattern = "^(http\://[\w]+\.[\w]+/[\w]+)(( )+(pic\.[\w]+\.[\w]+/[\w]+))?$"
'If Chr(32) or Chr(160)
.Pattern = "^(http\://[\w]+\.[\w]+/[\w]+)((\x20|\xA0)+(pic\.[\w]+\.[\w]+/[\w]+))?$"
Else
'SAA
'.Pattern = "^(http\://[\w]+\.[\w]+/[\w]+)( )+(pic\.[\w]+\.[\w]+/[\w]+)$"
.Pattern = "^(http\://[\w]+\.[\w]+/[\w]+)(\x20|\xA0)+(pic\.[\w]+\.[\w]+/[\w]+)$"
End If

If .Test(Cell) Then
If FirstWord Then
URL = .Execute(Cell)(0).SubMatches(0)
Else
URL = .Execute(Cell)(0).SubMatches(2)
End If
Else
URL = vbNullString
End If
End With

End Function


If the strings are as pasted, I found that the first of the two spaces is 160 and the second 32 (both in CHR()), which threw me for a bit. The pattern allows for one or more of either space character.

Hope that helps,

Mark

[1819]

Thank you both very much for your help. I am testing it on my data later today.