extract certain data from txt file into a new excel file

[bailong]

Hi, I am new to VBA. Could some one help me out? I want to extract certain data from txt file into a new excel file.

Here is the text file:

-----------------------------------------------------------------
fit results # 1 for wafer: Wafer #01 - Edi - Center
substrate A
substrate temp. 600.71 °C
substrate start 2818.87 s
substrate end 3628.88 s
layer A
layer temp. 600.77 °C
layer start 2802.67 s
layer end 4349.34 s
wavelength 450.05 nm
bandwidth 5.17 nm
energy 1.31 eV
phi 0.00 eV
run_id D045
mach_id Edi 34-0875-2010
operator <unknown>
location <unknown>
date 2013-04-24
time 11:47:09
info <unknown>
fit-results of fit-method: n-k-r fit: independent optical indices n/k, growth rate r - virtual layer
parameter value error
n 3.5030 0.01647
k 0.1814 0.02991
r(nm/s) 0.5314 0.01186
r(µm/h) 1.9131 0.04270
d(nm) 821.9255 18.34456
d(µm) 0.8219 0.01834
fit-delta 0.479
oscillation period 255.177s
date-time-stamp 2013-04-24-14-16-02
-----------------------------------------------------------------
-----------------------------------------------------------------
fit results # 2 for wafer: Wafer #02 - Edi - Center
substrate A
substrate temp. 603.73 °C
substrate start 2818.87 s
substrate end 3628.88 s
layer A
layer temp. 603.86 °C
layer start 2802.67 s
layer end 4349.34 s
wavelength 450.05 nm
bandwidth 5.17 nm
energy 1.31 eV
phi 0.00 eV
run_id D045
mach_id Edi 34-0875-2010
operator <unknown>
location <unknown>
date 2013-04-24
time 11:47:09
info <unknown>
fit-results of fit-method: n-k-r fit: independent optical indices n/k, growth rate r - virtual layer
parameter value error
n 3.5037 0.01678
k 0.1675 0.03065
r(nm/s) 0.5266 0.01199
r(µm/h) 1.8959 0.04317
d(nm) 814.5496 18.54856
d(µm) 0.8145 0.01855
fit-delta 0.510
oscillation period 257.434s
date-time-stamp 2013-04-24-14-16-17
-----------------------------------------------------------------

And I want to extract the red data and output like this:

[TABLE="width: 308"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD] [/TD]
[TD]substrate temp.[/TD]
[TD]rate[/TD]
[/TR]
[TR]
[TD]wafer #01[/TD]
[TD="align: right"]600.71[/TD]
[TD="align: right"]0.5314[/TD]
[/TR]
[TR]
[TD]wafer #02[/TD]
[TD="align: right"]603.73[/TD]
[TD="align: right"]0.5266[/TD]
[/TR]
</tbody>[/TABLE]
<strike></strike>

<strike></strike>I appreciate your kind help,

 

[igold]

Hi bailong,

Welcome to the MrExcel Forum.

I have a question, in the sample text file you are showing above, I understand that they are two different sets of data, what is not clear to me is, would this be considered one text file or are you showing two individual text files as an example.

In other words, will the code be run on the wafer 01 text and then at another time the code would be run on the wafer 02 text. Or is the example exactly as you get it, and might there be additional wafers in the text file.

I hope that makes sense.

 

[bailong]

Hi, igold:

Thank you for the reply!
It is the example as I get it, and there are more wafers in the text file, the pattern repeats!

bailong

 

[igold]

I am not sure that this is the best way to attack this problem but given the sample set of Text data you provided, this tested out for me.

That said, and if your data stays consistent with your sample, the only thing you need to do is change the Path and the File Name (highlighted in red) to your needs.

The code will write the Header row in Row 1, and the extracted data starting in Row 2 on the activesheet.

Sub TextFile()


Dim Delimiter1 As String, Delimiter2 As String, Delimiter3 As String, FilePath As String
Dim hdr, wr As Range, TextFile As Integer
Dim FileContent As String, LineArray() As String, DataArray() As String, TempArray() As String
Dim rw As Long, col As Long, x As Long, Y As Long, C As Long


    Delimiter1 = "wafer: "
    Delimiter2 = "substrate temp. "
    Delimiter3 = "r(nm/s) "
    FilePath = [COLOR=#ff0000]"G:\Excel VBA\NewTest.txt"   'CHANGE PATH and FILE NAME TO YOUR NEEDS[/COLOR]
    rw = 0
    hdr = Array("Wafer", "Substrate Temp", "Rate")
    TextFile = FreeFile
    Open FilePath For Input As TextFile
    FileContent = Input(LOF(TextFile), TextFile)
    Close TextFile
  
    LineArray() = Split(FileContent, vbCrLf)
    ReDim DataArray(UBound(LineArray))


    For x = LBound(LineArray) To UBound(LineArray)
        If Len(Trim(LineArray(x))) <> 0 Then
            TempArray = Split(LineArray(x), Delimiter1)
                If UBound(TempArray) > 0 Then
                    DataArray(rw) = TempArray(1)
                    rw = rw + 1
                End If
            TempArray = Split(LineArray(x), Delimiter2)
                If UBound(TempArray) > 0 Then
                    DataArray(rw) = TempArray(1)
                    rw = rw + 1
                End If
            TempArray = Split(LineArray(x), Delimiter3)
                If UBound(TempArray) > 0 Then
                    DataArray(rw) = TempArray(1)
                    rw = rw + 1
                End If
        End If
    Next
    
    ReDim Preserve DataArray(rw - 1)
    
    For x = LBound(DataArray, 1) To UBound(DataArray, 1)
        If Left(DataArray(x), 5) = "Wafer" Then
            DataArray(x) = Trim(Left(DataArray(x), 9))
        End If
        If Right(DataArray(x), 3) = " °C" Then
            DataArray(x) = Trim(Left(DataArray(x), 7))
        End If
        If Left(DataArray(x), 2) = "0." Then
            DataArray(x) = Trim(Left(DataArray(x), 6))
        End If
    Next
    
    Range("A1:C1") = hdr
    Set wr = Range("A2: C" & ((UBound(DataArray) + 1) / 3) + 1)
    
    For C = 1 To wr.Cells.Count
        wr.Cells(C).Value = DataArray(C - 1)
    Next
    
    ActiveSheet.Columns.AutoFit


End Sub

I hope this helps...

 

[bailong]

Hi, igold:


Thank you very much for your help. I tried and it is working, I will try best to understand and modify a little bit to get all corrected. Will let you know if still need more help.

Thanks again!

bailong

 

[igold]

You're welcome. I am glad it is working for you. Thanks for the feedback!