VBA Excel insert the symbol after 2nd character of the string

Question

I have a set of coordinates, which I would like to divide. I would like to have proper numbers with decimals, which doesn't happen in my worksheet, as I get messy data.

The first image shows the initial coordinates label. The second one shows the coordinates after split.

I need here the numbers with decimal.

I tried to divide them by the number, but it didn't work.

    Sub Coordinatesfinal()
    Columns("F:G").Insert Shift:=xlToRight

    ActiveSheet.Range("E1").Value = "Latitude"
    ActiveSheet.Range("F1").Value = "Longitude"

    Dim rang As Range, cell As Range, rg As Range, element As Range, rg2 As Range
    Dim r1 As Range, r2 As Range
    Dim wors As Worksheet
    Set wors = ActiveSheet
    Dim myString As String
    myString = "."

    Dim LastRow As Long, i As Long, SecondLastRow As Long

    LastRow = wors.Range("E" & wors.Rows.Count).End(xlUp).Row
    Set rang = wors.Range("E2:E" & LastRow)
    For Each cell In rang
    cell = WorksheetFunction.Substitute(cell, ",", " ")
    cell = WorksheetFunction.Substitute(cell, "  ", " ")
    cell = WorksheetFunction.Substitute(cell, ",,", " ")
    Next

    Set rg = [E2]
    Set rg = Range(rg, Cells(Rows.Count, rg.Column).End(xlUp))


     rg.TextToColumns Destination:=rg, DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
    FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    
    If InStr(myString, ".") > 0 Then
    Exit Sub
    End If

    With words
    LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
    SecondLastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
    End With

    For Each element In wors.Range("E2:E" & LastRow)
    cell.Value = cell.Value / 1000000
   Next

    For i = 2 To LastRow
    Set r1 = Range("E" & i)
   Set r2 = Range("F" & i)
    If r1.Value > 54.5 Or r1.Value < 50 Then r1.Interior.Color = vbYellow
    If r2.Value > 2 Or r2.Value < -7 Then r2.Interior.Color = vbCyan
   'If r1.Value = 3 Then r2.Interior.Color = vbYellow
    Next i

     rg.TextToColumns Destination:=rg, DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, _
    FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

    MsgBox ("Coordinates prepared successfully")

    End Sub

The

    For Each element In wors.Range("E2:E" & LastRow)
     cell.Value = cell.Value / 1000000
     Next

VBA: Macro to divide range by a million

doesn't work at all, as same as:

   For Each element In wors.Range("F2:F" & SecondLastRow)
    If IsNumeric(element.Value) Then
    If Len(element.Value) > 7 And Len(element.Value) < 9 Then
    element.Value = element.Value / 1000000
    ElseIf Len(element.Value) < 8 Then
    element.Value = element.Value / 100000
    Else
    element.Value = element.Value / 10000000
    End If
    End If
  Next

I don't know where might be the problem. As I might have several cases based on my total string length I would like to ask about some possibility of insert the "." symbol after 2nd character in my strings.

I tested this function:

Excel/VBA - How to insert a character in a string every N characters

but without any result.

Is there any way to divide these numbers or simply insert the "." symbol after 2nd number?

This is an output I would like to have

user_478884 · Answer

Something like this should work:

Sub Coordinatesfinal()
    
    Dim ws As Worksheet, rngData As Range, arrIn, arrOut, r As Long, d, arr
    
    Set ws = ActiveSheet
    Set rngData = ws.Range("E2", ws.Cells(Rows.Count, "E").End(xlUp))
    arrIn = rngData.Value  'get input data as array
    
    ReDim arrOut(1 To UBound(arrIn, 1), 1 To 2) 'size array for output data
    
    'clean raw value
    For r = 1 To UBound(arrIn, 1)
        d = Trim(Replace(arrIn(r, 1), ",", " ")) 'remove commas
        Do While InStr(d, "  ") > 0
            d = Replace(d, "  ", " ") 'remove any double spaces
        Loop
        
        arr = Split(d, " ") 'split on space
        arrOut(r, 1) = FormatValue(arr(0))                            'Lat
        If UBound(arr) > 0 Then arrOut(r, 2) = FormatValue(arr(1))    'Long
    Next r
    
    ws.Columns("F:G").Insert Shift:=xlToRight
    ws.Range("F1:G1").Value = Array("Latitude", "Longitude")
    With ws.Range("F2").Resize(UBound(arrIn, 1), 2)
        .NumberFormat = "General"
        .Value = arrOut
    End With

End Sub

'convert to decimal if numeric, according to length
Function FormatValue(ByVal v)
    If IsNumeric(v) And InStr(v, ".") = 0 Then
        v = CLng(v)
        Select Case Len(v)
            Case 8: FormatValue = v / 1000000
            Case Is < 8: FormatValue = v / 100000
            Case Else: FormatValue = v / 10000000
        End Select
    Else
        FormatValue = v
    End If
End Function

user_7177346 · Answer

No a complete answer to the OP but the code below may help in returning an array of latitude and longitude doubles when provided with a composite string.


Public Const SPACE As String = " "
Public Const COMMA As String = ","


Public Enum Position

    latitude
    longitude
    
End Enum

Public Sub ttest()

    Dim myArray As Variant
    myArray = ConvertLatLongStringToLatLongDoubles("    51519636   -1081282     ")
    Debug.Print myArray(latitude)
    Debug.Print myArray(longitude)
    
End Sub

' Return a variant containing an array of two doubles
' Index 0 is Latitude
' Index 1 is longitude
Public Function ConvertLatLongStringToLatLongDoubles(ByVal ipPosition As String) As Variant

    ' Clean up the incoming string
    Dim myPosition As String
    myPosition = Trimmer(ipPosition)
    myPosition = Dedup(myPosition, SPACE)
    ' add other dedups as required as
    
    
    ' SPlit the string at the remaining SPACE
    Dim myLatLong As Variant
    myLatLong = Split(myPosition)
    myLatLong(Position.latitude) = CDbl(myLatLong(Position.latitude)) / 1000000
    myLatLong(Position.longitude) = CDbl(myLatLong(Position.longitude)) / 1000000

    ConvertLatLongStringToLatLongDoubles = myLatLong
    
End Function

' Dedup replaces character pairs with a single character
' Dedup operates until no more pairs can be found.
' ipDedup should be a string (usually a single character)
' that need to be deduped
Public Function Dedup(ByVal ipSource As String, ByVal ipDedup As String) As String

    Dim mySource As String
    mySource = ipSource
    Dim MyDedupDedup As String
    MyDedupDedup = ipDedup & ipDedup
    
    Do
    
        Dim myLen As Long
        myLen = Len(mySource)
        mySource = Replace(mySource, MyDedupDedup, ipDedup)
        
    Loop Until myLen = Len(mySource)
    
    Dedup = mySource
    
End Function

' Trimmer will remove any single character specified in ipTrimChars
' from the start and end of the string
Public Function Trimmer(ByVal ipString As String, Optional ByVal ipTrimChars As String = " ,;" & vbCrLf & vbTab) As String

    Dim myString As String
    myString = ipString
    
    Dim myIndex As Long
    For myIndex = 1 To 2
    
        If VBA.Len(myString) = 0 Then Exit For
    
        Do While VBA.InStr(ipTrimChars, VBA.Left$(myString, 1)) > 0
              
            DoEvents ' Always put a do event statement in a do loop
            
            myString = VBA.Mid$(myString, 2)
            
        Loop
        
        myString = VBA.StrReverse(myString)
    
    Next
    
    Trimmer = myString
    
End Function

VBA Excel insert the symbol after 2nd character of the string

2 Answers