Importing large text file, extracting lat-long, and converting to decimal

[fcc77]

Hello,

New to coding and VBA. I have a single column text file with FCC records (over 1000) that I'm importing into Excel. I'm pulling out lines starting with 102 and 303 for each record. They are record names and lat-longs.


The ultimate goal is to be able to pull out all lat-longs and have them converted to decimal form ex. 37.345324 in one column and 77.323212 in another column.


I am able to pull out 102 and 303 but need help with a loop and use of Mid(x, y, z) function that separates each degree minute second of lat-long and converts it into decimal.


Thank you


Here is a sample file:


005. UA
010. N
102. FCC 000001
110. M458.0625
113. MO
114. 11K3F2D
115. W1.000
117. 36.02
140. 20150609
141. 20250802
144. U
200. FCC
203. PW
300. MD
303. 391121N0762232W
304. WP44821
306. 3
373. A
502. $L MAIL STATE: MD
502. $FCCPUB
901. A
911. 20150609
924. FCC
927. 20150609
005. UA
010. N
102. FCC 000002
110. M5965.20
113. DFSS
114. 882KF9W
117. 97.40
140. 19921120
141. 20021106
144. U
200. FCC
203. CS
300. MD
301. FTM
303. 390343N0764533W
304. E921590
354. ESA320
356. 12
357. 55
358. 49
363. Z
373. A
502. $L MAIL STATE: VA
502. $L NUM UNITS: 0
901. A
911. 19921120
924. FCC
927. 19921120
005. UA
010. N
102. FCC 000003
110. M6064.0
113. DFSS
114. 882KF9W
117. 97.40
140. 19921120
141. 20021106
144. U
200. FCC
203. CS
300. MD
301. FTM
303. 390011N0774455W
304. E421590
354. ESA120
356. 12
357. 55
358. 49
363. Z
373. A
502. $L MAIL STATE: VA
502. $L NUM UNITS: 0
901. A
911. 19921120
924. FCC
927. 19921120


Here is my code so far:

Sub Sample()
Dim fn As Integer
Dim MyData As String
Dim lineData As String, strData() As String, myFile As String
Dim i As Long, rng As Range

myFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")

Set rng = Range("D1")

fn = FreeFile
Open myFile For Input As #fn
i = 1
Do While Not EOF(fn)
Line Input #fn, lineData
strData = Split(lineData, "|")
rng.Cells(i, 1).Resize(1, UBound(strData) + 1) = strData
i = i + 1
Loop
Close #fn

Dim counter As Long
counter = 2

For Each cell In Range("A1", Range("A1").SpecialCells(xlCellTypeLastCell)
If InStr(1, cell, "102.") > 0 Then
Cells(counter, 1) = (Mid(cell, InStr(1, cell, ".") + 1, 30))
End If

If Left(Trim(cell), 4) = "303." Then
Cells(counter, 2) = Mid(cell, InStr(1, cell, ".") + 1, InStr(1, cell, "W") - InStr(1, cell, ".") - 1)
counter = counter + 1
End If
Next
End Sub

[SamT]

Untested

    For Each cell In Range("A1", Range("A1").SpecialCells(xlCellTypeLastCell) 
        If Left(Trim(cell), 4) = "102." Then 
            Cells(counter, 3) = Mid(cell, 5) 
        End If 
         
        If Left(Trim(cell), 4) = "303." Then 
            Cells(counter, 4) = Mid(cell, 6, 8)
            Cells(counter, 5) = Right(cell, 8)
            counter = counter + 1 
        End If 
Next

[mdmackillop]

Give this a try

Sub Sample()
    Dim fn As Long
    Dim MyData As String
    Dim lineData As String, strData() As String, myFile As String
    Dim i As Long, rng As Range, cell As Range
    
    myFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    Set rng = Range("A1")
    fn = FreeFile
    Open myFile For Input As #fn
    i = 1
    Do While Not EOF(fn)
        Line Input #fn, lineData
        strData = Split(lineData, "|")
        rng.Cells(i, 1).Resize(1, UBound(strData) + 1) = strData
        i = i + 1
    Loop
    Close #fn
    
    For Each cell In Range("A1", Range("A1").SpecialCells(xlCellTypeLastCell))
        If InStr(1, cell, "102.") > 0 Then
            cell.Offset(, 1) = (Mid(cell, InStr(1, cell, ".") + 1, 30))
        End If
        If Left(Trim(cell), 4) = "303." Then
            Deg = Trim(Mid(cell, InStr(1, cell, ".") + 1, InStr(1, cell, "W") - InStr(1, cell, ".") - 1))
            cell.Offset(, 1) = DecDeg(Left(Deg, 6))
            cell.Offset(, 2) = DecDeg(Right(Deg, 6))
        End If
    Next
End Sub


Function DecDeg(Data) As Single
    Dim Deg, Min, Sec
    Deg = Mid(Data, 1, 2)
    Min = Mid(Data, 3, 2)
    Sec = Mid(Data, 5, 2)
    DecDeg = Deg + Min / 60 + Sec / 3600
End Function

[fcc77]

Thank you guys for the quick reply. mdmackillop - this works great! Would it be hard to get it to output in the format of the photo below...

sdf.png

[mdmackillop]

No problem

For Each cell In Range("A1", Range("A1").SpecialCells(xlCellTypeLastCell))
        If InStr(1, cell, "102.") > 0 Then
            Cells(Rows.Count, 4).End(xlUp)(2) = (Mid(cell, InStr(1, cell, ".") + 1, 30))
        End If
        If Left(Trim(cell), 4) = "303." Then
            Deg = Trim(Mid(cell, InStr(1, cell, ".") + 1, InStr(1, cell, "W") - InStr(1, cell, ".") - 1))
            Cells(Rows.Count, 5).End(xlUp)(2) = DecDeg(Left(Deg, 6))
            Cells(Rows.Count, 6).End(xlUp)(2) = DecDeg(Right(Deg, 6))
        End If
    Next

[fcc77]

Excellent! Thank you again!

Solved