Splitting and Moving data with VBA

Splitting data can be a cumbersome and highly manual task, and could result in inaccurate data. Splitting data, moving it about and intelligently preparing large amounts of extracted data can be accomplished in seconds using a datanology VBA Solution.

In the short example below (data sanitised under DPA) the extracted data which was originally 12,000 names and email addresses was manipulated into a single row, and the forename and surname associated with the email was split from its single string into a structured ‘First Name’, ‘Surname’ before being linked back to it’s associated email address. The data was structured such that the persons name was listed, a blank row, their email address and then the next persons name without any blank row. The solution created allowed for this logic to be followed and obtain the accurate and quick result.

The VBA Solution can be carried out over and over again, obtaining thousands of results within seconds, and removing the scope for errors and wasted time cutting, pasting etc.

Datanology Email Split

This VBA Code appears in several snippets, including a UDF to identify the First name, and a UDF to identify the Surname. The entire code needs to be pasted into the VB Editor (ALT+F11) but can be amended as you see fit to adapt to your own dataset.

Function GETFIRSTWORD(Text As String, Optional Separator As Variant)
Dim firstword As String
If IsMissing(Separator) Then
Separator = " "
End If
firstword = Left(Text, InStr(1, Text, Separator, vbTextCompare))
GETFIRSTWORD = Replace(firstword, Separator, "")
End Function

Function ReturnLastWord(The_Text As String)
Dim stGotIt As String
stGotIt = StrReverse(The_Text)
stGotIt = Left(stGotIt, InStr(1, stGotIt, " ", vbTextCompare))
ReturnLastWord = StrReverse(Trim(stGotIt))
End Function

Sub Button1_Click()
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
OTP = 2
'find the first row that is not blank and is not an email address
For n = 1 To lastrow
x = ActiveSheet.Range("A" & n)
y = InStr(1, x, "@")
If x <> "" And y = 0 Then
'Name found
'Move first word to col A, last word to col B and email that is 2 cells below to col C
Worksheets("Output").Range("A" & OTP) = GETFIRSTWORD(ActiveSheet.Range("A" & n))
Worksheets("Output").Range("B" & OTP) = ReturnLastWord(ActiveSheet.Range("A" & n))
Worksheets("Output").Range("C" & OTP) = ActiveSheet.Range("A" & n + 2)
OTP = OTP + 1
End If
Next n
End Sub

If you’d like to discuss data splitting, moving and manipulation of any sort please feel free to leave us a message below or contact us through the form below. We could transform your business data process in as little as 24hrs, sometimes quicker.

Contact us for some advice and guidance on how your Excel development could be created and start helping your business straight away. Contact Us


2 thoughts on “Splitting and Moving data with VBA

  1. Datanology says:

    Thanks, yes this is possible to complete in a VBA solution. You will need to determine the type of split, such as property number in the same cell as the road name but this would be a relatively quick development for you.

  2. Mark Hutchings says:

    I have a requirement very similar to this, but the postal address is also required to be split into the next columns along. Can you let me know if this is possible using one of your VBA solutions please.

    Many thanks

    Mark Beanstock

Leave a Reply

Your email address will not be published. Required fields are marked *