Macro to copy from a text document into excel document

**JRoder** · 07-24-2012, 01:29 PM

Greetings,

I have to copy the same information from the same type of text document over and over into the same excel document to create datasheets. I have used VBA to create a streamwriter in a stand alone application but have never used one in conjunction with excel. I am having problems with figuring out how to open the text document to copy and move the focus to different cells in excel.

Thanks

jroder

**JBeaucaire** · 07-24-2012, 05:07 PM

I would think you would need to provide a couple of sample text files and a sample Excel file where you've mocked up your needed results from those text files so we can see the BEFORE and AFTER. Then we can suggest methods of bridging the gap.

**JRoder** · 07-24-2012, 05:55 PM

Here are Before and After excel files for everyone to look at and the text file to copy from:

The items needed from the text file are:

EPHEMERIS
SOFTWARE
START
FIXED AMB
OVERALL RMS
THE ERROR FOR:
LAT
W LON
EL HGT
ORTHO HGT

They need to be moved over to the excel file in the cells labeled with their names. Every excel file will be the same and every text file is in the same format. I have tried to splice the text file up with the text to columns function and then recording a macro but there is not an easy way to divide the text because of all the spaces.

Thanks,

jroder

**Tinbendr** · 07-24-2012, 09:17 PM

Sub ImportData()

    Dim WS As Worksheet
    Dim FN As Variant
    Dim FF As Integer
    Dim MyArray As Variant
    Dim Path As String
    Dim A As Long
    Dim Temp$
    Dim iFound As Long

    Set WS = ActiveWorkbook.Worksheets(1)

    FN = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If FN <> False Then
        FF = FreeFile
        Open FN For Input As #FF
        Do Until EOF(FF)

            Line Input #FF, Temp$
            'Second Keywords on same line are skipped since it will be parsed at same time.
            MyArray = Array("SOFTWARE:", "EPHEMERIS:", "FIXED AMB:", "OBS USED", "OVERALL RMS:", "LAT:", _
                            "W LON:", "EL HGT:", "ORTHO HGT:", "THE ERROR FOR")

            For A = 1 To UBound(MyArray)
                iFound = InStr(MyArray(A), Temp$)

                If iFound > 0 Then
                    Select Case MyArray(A)
                    Case "SOFTWARE:"
                        WS.Range("O30").Value = Trim(Mid(Temp$, 13, 51 - 13))
                        'START is on same line as software, so we parse it here.
                        WS.Range("G33").Value = Trim(Mid(Temp$, 52, 80 - 52))

                    Case "EPHEMERIS:"
                        WS.Range("O29").Value = Trim(Mid(Temp$, 13, 51 - 13))

                    Case "OBS USED:"
                        WS.Range("O32").Value = Trim(Mid(Temp$, 77, 80 - 77))

                    Case "FIXED AMS:"
                        WS.Range("O31").Value = Trim(Mid(Temp$, 77, 80 - 77))

                    Case "OVERALL RMS:"
                        WS.Range("O33").Value = Trim(Mid(Temp$, 59, 80 - 59))

                    Case "LAT:"
                        WS.Range("G18").Value = Trim(Mid(Temp$, 13, 29 - 13))

                    Case "W LON:"
                        WS.Range("G19").Value = Trim(Mid(Temp$, 13, 29 - 13))

                    Case "EL HGT:"
                        WS.Range("G20").Value = Trim(Mid(Temp$, 13, 29 - 13))

                    Case "ORTHO HGT:"
                        WS.Range("G21").Value = Trim(Mid(Temp$, 13, 29 - 13))

                    Case "THE ERROR FOR:"
                        WS.Range("M29").Value = Trim(Mid(Temp$, 13, 51))

                    End Select
                End If
            Next
        Loop
        Close #FF
    End If
End Sub

**JRoder** · 07-25-2012, 01:13 PM

David,

Thanks for the reply especially since I accidentally posted this thread twice once in into forum.

The code is opening the file but for some reason iFound is staying at 0 on my Excel 2003 and then it is not cycling through the cases and just going straight to the end, can i use a different counter to do the job? I am trying to fix it myself, I will post another thread if i am able to get it. Also I am just curious what Dim Temp$ means?

Thanks,

jroder

**Tinbendr** · 07-25-2012, 04:31 PM

Oh, you want me to EXPLAIN everything? That'll cost ya! Hahaha! just joking!

This code worked on the sample file you u/led.

I'll have another look this evening and comment the code for you.

But for now, Dim Temp$ is the same as Dim Temp as String. It's shorthand left over from the early days. Each variable has it's own shortcut symbol.

Temp$ is just a temporary variable that is taking the text file in one line at a time. (Line Input)

Once I have Temp$, I check to see if our keyword (SOFTWARE: ) is anywhere in that line. (InStr) If it is, InStr will return the Starting Position of the match. So if iFound is anything other than 0, then we have a match. If it is 0, I loop to the next keyword until I check all the keywords, then read the next line and do it all over again.

Once a keyword is found, the Select case branches the code to the correct line to parse the info we need and post it to the spreadsheet.

**Tinbendr** · 07-25-2012, 07:31 PM

Oops, sorry. I had the InStr function backward. And You! You have merged cells! A cardinal sin of Excel worksheets. I had to add a function to handle those devils.

It seems to be working now. Some of the info might not be formatted just right, so tell what needs to be fixed.

Sub ImportData()

    Dim WS As Worksheet
    Dim FN As Variant
    Dim FF As Integer
    Dim MyArray As Variant
    Dim Path As String
    Dim A As Long
    Dim Temp$
    Dim iFound As Long

    Set WS = ActiveWorkbook.Worksheets(1)

    FN = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If FN <> False Then
        FF = FreeFile
        Open FN For Input As #FF
        Do Until EOF(FF)

            Line Input #FF, Temp$
            'Second Keywords on same line are skipped since it will be parsed at same time.
            MyArray = Array("SOFTWARE:", "EPHEMERIS:", "FIXED AMB:", "OBS USED", "OVERALL RMS:", "LAT:", _
                            "W LON:", "EL HGT:", "ORTHO HGT:", "THE ERROR FOR")

            For A = 0 To UBound(MyArray)
                iFound = InStr(Temp$, MyArray(A))

                If iFound > 0 Then
                    Select Case MyArray(A)
                    Case "SOFTWARE:"
                        'WS.Range("O30").Value = Trim(Mid(Temp$, 13, 51 - 13))
                        SetMergedCellValue 30, 15, Trim(Mid(Temp$, 13, 51 - 13))
                        'START is on same line as software, so we parse it here.
                        WS.Range("G33").Value = Trim(Mid(Temp$, 59, 80 - 59))
                        SetMergedCellValue 33, 7, Trim(Mid(Temp$, 52, 80 - 52))
                        
                    Case "EPHEMERIS:"
                        'WS.Range("O29").Value = Trim(Mid(Temp$, 13, 51 - 13))
                        SetMergedCellValue 29, 15, Trim(Mid(Temp$, 52, 80 - 52))

                    Case "OBS USED:"
                        'WS.Range("O32").Value = Trim(Mid(Temp$, 77, 80 - 77))
                        SetMergedCellValue 33, 7, Trim(Mid(Temp$, 77, 80 - 77))
                        
                    Case "FIXED AMS:"
                        'WS.Range("O31").Value = Trim(Mid(Temp$, 77, 80 - 77))
                        SetMergedCellValue 33, 7, Trim(Mid(Temp$, 77, 80 - 77))
                        
                    Case "OVERALL RMS:"
                        'WS.Range("O33").Value = Trim(Mid(Temp$, 59, 80 - 59))
                        SetMergedCellValue 33, 15, Trim(Mid(Temp$, 59, 80 - 59))

                    Case "LAT:"
                        'WS.Range("G18").Value = Trim(Mid(Temp$, 13, 29 - 13))
                        SetMergedCellValue 18, 7, Trim(Mid(Temp$, 13, 29 - 13))

                    Case "W LON:"
                        'WS.Range("G19").Value = Trim(Mid(Temp$, 13, 29 - 13))
                        SetMergedCellValue 19, 7, Trim(Mid(Temp$, 13, 29 - 13))

                    Case "EL HGT:"
                        'WS.Range("G20").Value = Trim(Mid(Temp$, 13, 29 - 13))
                        SetMergedCellValue 20, 7, Trim(Mid(Temp$, 13, 29 - 13))
                        
                    Case "ORTHO HGT:"
                        'WS.Range("G21").Value = Trim(Mid(Temp$, 13, 29 - 13))
                        SetMergedCellValue 21, 7, Trim(Mid(Temp$, 13, 29 - 13))

'                    Case "THE ERROR FOR:"
'                        WS.Range("M29").Value = Trim(Mid(Temp$, 13, 51))

                    End Select
                End If
            Next
        Loop
        Close #FF
    End If
End Sub

Sub SetMergedCellValue(iRow As Integer, iColumn As Integer, sNewInfo As String)

    Dim mRange As Excel.Range
    Set mRange = ActiveSheet.Cells(iRow, iColumn).MergeArea
    mRange.Cells(1, 1).Value = sNewInfo

End Sub