Kartick0075
New Member
- Joined
- Jan 9, 2020
- Messages
- 18
- Office Version
- 2019
- Platform
- Windows
Dear Respected Everyone,
I've come here with a request to solve this problem. I'm a newbie in VBA and learning it for the last few months. But, I got stuck in splitting Names (First, Middle [If Available] and Last) with One Single UDF Function in VBA. I successfully did it with Sub Procedure. But, I failed to do it with One SIngle UDF. I can't build logic to successfully achieve my purpose with One Single UDF Function. With my current VBA skills, It requires 3 UDF Functions (Each Function for Each Part of Name) to serve my purpose. I generally prefer Inbuilt or UDF Functions to Macros as they (Inbuilt or UDF Functions) are much more flexible. I mean to say, creating function once and use them anywhere in that workbook. Please help me...
I've given my Macro and incomplete UDF Code below:
=====================================================
Module: (CodeName:= Sheet1(SheetName:= Split Name))
------------------------------------------------------------------------------------------------------------
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
LastRow = Range("B" & Rows.Count).Row
If Application.Intersect(Range("B3:B" & LastRow), Target) Is Nothing Then
Rem Nothing is needed
Else
Call SplitNameViaSubProcedure
End If
End Sub
------------------------------------------------------------------------------------------------------------
Module: Generic (ModuleName:= Split_Name)
------------------------------------------------------------------------------------------------------------
Option Explicit
Option Base 1
Sub SplitNameViaSubProcedure()
Application.EnableEvents = False
Dim OuterLoop As Long
Dim InnerLoop As Long
Dim FirstRow As Long
FirstRow = Sheet1.Range("F3").Row
Dim LastRow As Long
LastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row - 2
Sheet1.Range("F" & FirstRow & ":" & "H" & Rows.Count).ClearContents
For OuterLoop = 1 To LastRow
Dim NameArray() As String
NameArray = Strings.Split(Expression:=Sheet1.Range("B" & OuterLoop + 2).Value, Delimiter:=" ")
For InnerLoop = 1 To UBound(NameArray) + 1
If UBound(NameArray) + 1 = 3 Then
Sheet1.Cells(OuterLoop + 2, InnerLoop + 5).Value = NameArray(InnerLoop - 1)
Else
Sheet1.Range("F" & OuterLoop + 2).Value = NameArray(InnerLoop - 1)
Sheet1.Range("H" & OuterLoop + 2).Value = NameArray(InnerLoop)
Exit For
End If
Next InnerLoop
Next OuterLoop
Application.EnableEvents = True
End Sub
=====================================================
But, I can't achieve it with One Single UDF. I'm also sharing this incomplete code...
=====================================================
Option Explicit
Option Base 1
Function SplitNameViaUDF(InputRange As Range) As String
Dim NameArray() As String
NameArray = Strings.Split(Expression:=InputRange.Value, Delimiter:=" ")
SplitNameViaUDF = NameArray(0)
End Function
=====================================================
I've come here with a request to solve this problem. I'm a newbie in VBA and learning it for the last few months. But, I got stuck in splitting Names (First, Middle [If Available] and Last) with One Single UDF Function in VBA. I successfully did it with Sub Procedure. But, I failed to do it with One SIngle UDF. I can't build logic to successfully achieve my purpose with One Single UDF Function. With my current VBA skills, It requires 3 UDF Functions (Each Function for Each Part of Name) to serve my purpose. I generally prefer Inbuilt or UDF Functions to Macros as they (Inbuilt or UDF Functions) are much more flexible. I mean to say, creating function once and use them anywhere in that workbook. Please help me...
I've given my Macro and incomplete UDF Code below:
=====================================================
Module: (CodeName:= Sheet1(SheetName:= Split Name))
------------------------------------------------------------------------------------------------------------
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
LastRow = Range("B" & Rows.Count).Row
If Application.Intersect(Range("B3:B" & LastRow), Target) Is Nothing Then
Rem Nothing is needed
Else
Call SplitNameViaSubProcedure
End If
End Sub
------------------------------------------------------------------------------------------------------------
Module: Generic (ModuleName:= Split_Name)
------------------------------------------------------------------------------------------------------------
Option Explicit
Option Base 1
Sub SplitNameViaSubProcedure()
Application.EnableEvents = False
Dim OuterLoop As Long
Dim InnerLoop As Long
Dim FirstRow As Long
FirstRow = Sheet1.Range("F3").Row
Dim LastRow As Long
LastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row - 2
Sheet1.Range("F" & FirstRow & ":" & "H" & Rows.Count).ClearContents
For OuterLoop = 1 To LastRow
Dim NameArray() As String
NameArray = Strings.Split(Expression:=Sheet1.Range("B" & OuterLoop + 2).Value, Delimiter:=" ")
For InnerLoop = 1 To UBound(NameArray) + 1
If UBound(NameArray) + 1 = 3 Then
Sheet1.Cells(OuterLoop + 2, InnerLoop + 5).Value = NameArray(InnerLoop - 1)
Else
Sheet1.Range("F" & OuterLoop + 2).Value = NameArray(InnerLoop - 1)
Sheet1.Range("H" & OuterLoop + 2).Value = NameArray(InnerLoop)
Exit For
End If
Next InnerLoop
Next OuterLoop
Application.EnableEvents = True
End Sub
=====================================================
But, I can't achieve it with One Single UDF. I'm also sharing this incomplete code...
=====================================================
Option Explicit
Option Base 1
Function SplitNameViaUDF(InputRange As Range) As String
Dim NameArray() As String
NameArray = Strings.Split(Expression:=InputRange.Value, Delimiter:=" ")
SplitNameViaUDF = NameArray(0)
End Function
=====================================================