PDA

View Full Version : [SOLVED] Importing large text file, extracting lat-long, and converting to decimal



fcc77
05-25-2017, 02:06 PM
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
05-25-2017, 02:39 PM
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
05-25-2017, 02:49 PM
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
05-25-2017, 03:07 PM
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...

19291

mdmackillop
05-25-2017, 03:25 PM
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
05-25-2017, 03:34 PM
Excellent! Thank you again!

Solved