Solved: Split Longitude and Latitude values

Hello All,

I have a range of Longitude and Latitude values; all that are separated by commas but some may also have space after the comma.

I am after a macro that if a range of cells is selected (column may vary) it will copy the selected range and paste the first part of the string before the comma into the cell to the first right of the original value and the next part in the second cell to the right.

'-36.759327,141.847336 = -36.759327 | 141.847336 (Works fine)
'-36.759327, 141.847336 = Run-time error ‘5’:

The following macro works well but only works on a single cell (i.e. ActiveCell) at a time and if there is a space after the comma a Run-time error ‘5’: occurs.

Can the following macro be modified to cope with either no space after the comma or if there is a space.

Is there a better solution that someone could offer...

[vba]
Sub zx()
'http://superuser.com/questions/352253/how-do-i-separate-a-comma-separated-list-into-two-columns-in-excel
Dim a() As String
Dim v As Variant
Dim i As Long
Dim j As Long
a = Split(ActiveCell.Value, " ")
ReDim v(1 To UBound(a) + 1, 1 To 2)
For i = 1 To UBound(a) + 1
j = InStr(a(i - 1), ",")
v(i, 1) = Val(Left(a(i - 1), j - 1))
v(i, 2) = Val(Mid(a(i - 1), j + 1))
Next
ActiveCell.Offset(0, 1).Resize(UBound(a) + 1, 2) = v
End Sub
[/vba]

I have recorded a macro that copes with or without spaces... but applies to range B8 only:
[vba]
Sub Macro2()
'
Selection.TextToColumns Destination:=Range("B8"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=True, Other:=False, FieldInfo:= _
Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End Sub
[/vba]

Regards,
Dave T

In sub zx
Declare a As a Range
Set a= the entire column of cells
ReDim v to a.Count rows and 2 columns (Array(RowCount-1, 1))
The j assignment is fine and the first v() assignment only needs the a.Cells(index) adjusted

This line[vba]v(i, 2) = Val(Mid(a(i - 1), j + 1)) [/vba] Should read [vba]v(i, 2) = Val(Trim(Right(a.Cells(i), j))) [/vba]

[VBA]
Sub M_snb()
Selection.TextToColumns Selection.Offset(, 1), , , , False, False, True, False, False
End Sub
[/VBA]

snb,

I love it! 12 lines into 1.

Hello SamT and snb,

I really appreciate your both of your replies.

SamT,
I must admit the initial 'zx' code I posted first had me total stumped.
I have been able to look at other macros and work out the parts that need tweaking to suit my needs, but I was struggling with how that one was written and the parts I needed to change.

SamT, I did try to make the changes you suggested, but I must admit I found what you recommended hard to follow and was unable to make it work.
I also appreciated your comments about what needed to be changed and what these changes would do, good learning material.

Just out of curiosity can you please post your full macro with your suggested changes so I can have a look at what it is doing.
____________________________________________________

snb,
I would have to agree with SamT and say wow...

Can you please provide me with a very quick explanation of how your code works.

Thanks again to both of you.

Regards,
Dave T

Here you go. Enjoy your reading. :)

I did only simple testing. You should really uncomment the first Test, (the fifth comment line in the Procedure,) AFTER you know why it's there and what it checks for.

This code goes in the code page for the sheet with the lat and long numbers on it.
[vba]Option Explicit 'Really, really should be at the top of all code pages.


'Selection Change is a Worksheet event that can trigger a "Macro."
Sub Worksheet_SelectionChange(ByVal Target As Range)
'This procedure starts everytime you select one or more cells on the sheet.

'By SamT at http://www.vbaexpress.com/forum/showthread.php?t=46381

'If you know that the Lats and Longs will always be in the same column,
'then, assuming Column "A", a simple test for that column is:

'If Intersect(Target, Range("A:A") is Nothing Then Exit Sub

'If you uncomment the above test, ths procedure will not run if
'the selection is not in Column A.

'The next test is to see if more than one column is selected
If Target.Columns.Count <> 1 Then Exit Sub

'Finally ask the User if they really want to run this Procedure.
Dim Answer As Integer 'Recieves the User's answer from the MsgBox
Dim msgPrompt As String 'The actual message
Dim msgTitle As String 'Appears in the Title Bar of the MsgBox
Dim msgButtons As Long 'The buttons that will be in the MsgBox

'The Space+Underscore below continues the code on the next line.
msgPrompt = "Do you want to Split these Lat/Long pairs" _
& "and put them into the adjacent columns?" 'The Ampersand concatenates two strings.
msgTitle = "Fix Latitude and Longitude?"
msgButtons = vbYesNo 'vbYesNo is a system Constant.

'Prompt, Title, and Buttons are Named arguments. The Values follow the ":=".
'argument values can also be passed by position, but this means insuring that
'all the arguments and separator commas are in the right order.

'Get the Answer
Answer = MsgBox(Prompt:=msgPrompt, Title:=msgTitle, Buttons:=msgButtons)
'Read the Answer
If Answer = vbNo Then Exit Sub

'The User really wants to fix the Lats and Longs, so continue
Dim cp As Long 'Holds commas position in the Lat,Long String
Dim Cel As Range
For Each Cel In Target

'Find the comma's position.
cp = InStr(Cel.Value, ",")

'If cp = 0 then it's an empty cell, skip to the End If
If Not cp = 0 Then

'Set the Cell 1 to the right to the value on the Left side of the comma
Cel.Offset(0, 1).Value = Left(Cel.Value, cp - 1)

'set the Cell 2 to the right, to the value to the Right of the comma,
'after Trimming all leading and trailing spaces. Left() and Right()
'need lengths, thats why the second argument uses the Len() function.
Cel.Offset(0, 2).Value = Trim(Right(Cel.Value, Len(Cel.Value) - cp))
End If
Next
End Sub
[/vba]

Hello SamT,

Thanks for your very detailed explanation.

I was aware of the need to uncomment one line of your code and spotted your 'deliberate' mistake:
If Intersect(Target, Range("A:A") Is Nothing Then Exit Sub
Which should have been:
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub

A very helpful explanation that is appreciated and I will look at closely.

Regards,
Dave T