Excel VBA help: Text file formatting

  • Thread starter Thread starter Nila
  • Start date Start date
N

Nila

Hello Everyone,

I need to do the following functions using excel vba

1. Ask user to select the text file using userform
2. Load the text file into excel (delimit by ',' and '=') - (sheet name :test)
3. Delete first 14 lines
4. Create a new sheet -( sheet name : sheet2)
5. Search file for ##RETENTION_TIME and ##NPOINTS, Copy the value of ##RETENTION_TIME to the new sheet (sheet1) based on ##NPOINTS. E.g: If ##RETENTION_TIME = 0.6 and ##NPOINTS = 10. 0.6 should be copied to cells from A1 to A10 in the sheet1. This should be repeated until it reaches the last row..

Following is the source code I have return for the above functionality. Thecode works fine till step 4. Step 5 is done by "sub sort". This is where Iam getting a compile error "Sub or function not defined". I am new to excel vba, I am not able to narrow down the issue further. Could anyone help meon this issue please? TIA.
Code
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim fileOpen As Variant

fileOpen = Application.GetOpenFilename("All Files(*.*),*.*")
If fileOpen = False Then Exit Sub
Workbooks.OpenText (fileOpen)
Range("A1").Select
Rows("1:14").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:= _
"=", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

Call sort

Close fileOpen
ActiveWindow.Close False
Application.ScreenUpdating = True

End Sub

Sub sort()

Dim x As Integer
Dim y As Integer
Dim erow As Long

y = 10
x = 2
Sheets.Add after:=Sheets(Sheets.Count)
Do While Cells(1, x) <> ""
If Cells(1, x) = "##RETENTION_TIME" Then
Worsksheets("test").cell(1, x).Copy
Worksheets("sheet1").Activate
erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste destindation:=Worksheets("sheet1").Range("erow" & ":" &"A" & "y")
End If
Worksheets("test").Activate
x = x + 1
Loop

End Sub
 
Step 5 is done by "sub sort". This is where I am getting a compile error "Sub or function not defined". I am new to excel vba, I am not able to narrow down the issue further. Could anyone help me on this issue please? TIA.

This is an outright shot in the dark, but I made these changes on the Sort sub. Does not error and produces a new worksheet each time I run it in a workbook with no data.

The name of the sub is purposefully change, as it produced an error. I presume "sort" is a reserved word for Excel.

Change the sheet names back to suit your workbook.

Regards,
Howard

Sub Mysort()

Dim x As Integer
Dim y As Integer
Dim erow As Range

y = 10
x = 2
Sheets.Add after:=Sheets(Sheets.Count)
Do While Cells(1, x) <> ""
If Cells(1, x) = "##RETENTION_TIME" Then
Sheets("Sheet2").cell(1, x).Copy
Sheets("sheet1").Activate
Set erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste destindation:=Worksheets("sheet1").Range("erow" & ":" & "A" & "y")
End If
Sheets("Sheet2").Activate
x = x + 1
Loop

End Sub
 
This is an outright shot in the dark, but I made these changes on the Sort sub. Does not error and produces a new worksheet each time I run it in a workbook with no data.



The name of the sub is purposefully change, as it produced an error. I presume "sort" is a reserved word for Excel.



Change the sheet names back to suit your workbook.



Regards,

Howard



Sub Mysort()



Dim x As Integer

Dim y As Integer

Dim erow As Range



y = 10

x = 2

Sheets.Add after:=Sheets(Sheets.Count)

Do While Cells(1, x) <> ""

If Cells(1, x) = "##RETENTION_TIME" Then

Sheets("Sheet2").cell(1, x).Copy

Sheets("sheet1").Activate

Set erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Paste destindation:=Worksheets("sheet1").Range("erow" & ":" & "A" & "y")

End If

Sheets("Sheet2").Activate

x = x + 1

Loop



End Sub

Thanks Howard, But it didn't work. Is there any way I can attach files in this forum?
 
Thanks Howard, But it didn't work. Is there any way I can attach files in this forum?

This is my input file structure(Sample not the actual file)

##SCAN_RANGE= 30,300
##SCAN_TIME_UNITS= Seconds
##XUNITS= m/z
##SCAN_NUMBER= 1
##RETENTION_TIME= 0.600
##TIC= 93832
##NPOINTS= 10
##XYDATA= (XY..XY)
30.92,269
30.99,317
32.59,302
33.26,337
34.86,492
34.99,316
36.66,319
37.79,295
38.92,269
38.99,262
##SCAN_NUMBER= 2
##RETENTION_TIME= 1.100
##TIC= 88976
##NPOINTS= 10
##XYDATA= (XY..XY)
30.39,157
31.52,221
32.72,321
33.26,263
34.46,317
35.52,289
36.66,361
37.85,313
37.99,157
39.65,246
##SCAN_NUMBER= 3
##RETENTION_TIME= 1.600
##TIC= 92650
##NPOINTS= 10
##XYDATA= (XY..XY)
30.46,199
31.12,284
32.79,339
33.39,337
33.99,272
35.66,317
36.85,458
36.99,384
37.99,232
39.65,425
##SCAN_NUMBER= 4
##RETENTION_TIME= 2.100
##TIC= 88625
##NPOINTS= 10
##XYDATA= (XY..XY)
30.59,164
31.12,316
32.26,285
33.46,353
34.12,335
35.19,351
36.32,290
37.52,284
38.59,278
39.79,414
##END=

I'm expecting my output file to be (Sample not the actual file)

0.6 30.92 269
0.6 30.99 317
0.6 32.59 302
0.6 33.26 337
0.6 34.86 492
0.6 34.99 316
0.6 36.66 319
0.6 37.79 295
0.6 38.92 269
0.6 38.99 262
1.1 30.39 157
1.1 31.52 221
1.1 32.72 321
1.1 33.26 263
1.1 34.46 317
1.1 35.52 289
1.1 36.66 361
1.1 37.85 313
1.1 37.99 157
1.1 39.65 246
 
If you post a link to an upload site (like 'box.com') so we can see the
text file contents, it will go a long way toward providing you with a
solution. Also, show an example on an Excel sheet of the results
expected for the sample text file you provide. Put both in a zip file
and post a download link...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
This shows how Excel imported the file, which won't do. Better that you
copy/paste the file contents because the original layout is important
for determining how to parse the file and retrieve the data.

Sample result is fine as posted.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Hi Nila,

Am Fri, 6 Jun 2014 22:31:16 -0700 (PDT) schrieb Nila:
I'm expecting my output file to be (Sample not the actual file)

0.6 30.92 269
0.6 30.99 317
0.6 32.59 302
0.6 33.26 337
0.6 34.86 492
0.6 34.99 316
0.6 36.66 319
0.6 37.79 295
0.6 38.92 269
0.6 38.99 262
1.1 30.39 157
1.1 31.52 221
1.1 32.72 321
1.1 33.26 263
1.1 34.46 317
1.1 35.52 289
1.1 36.66 361
1.1 37.85 313
1.1 37.99 157
1.1 39.65 246

try:

Sub Sort()
Dim cRet As Range, cNo As Range
Dim LRow As Long
Dim FirstAddress As String
Dim myCnt As Long
Dim First As Range
Dim ArrIn As Variant

'Modify sheet names
With Sheets("Test")
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set cRet = .Range("A1:A" & LRow).Find("##RETENTION_TIME", _
LookIn:=xlValues)
If Not cRet Is Nothing Then
FirstAddress = cRet.Address
Do
myCnt = Trim(Mid(cRet.Offset(2, 0), InStr(cRet.Offset(2, 0),
"=") + 1, 99))
Set First = Sheets("Sheet1").Cells(Rows.Count,
1).End(xlUp).Offset(1, 0)
First.Resize(rowsize:=myCnt) = Trim(Mid(cRet, InStr(cRet,
"=") + 1, 99))
ArrIn = cRet.Offset(4, 0).Resize(rowsize:=myCnt)
First.Offset(, 1).Resize(rowsize:=myCnt) = ArrIn
Set cRet = .Range("A1:A" & LRow).FindNext(cRet)
Loop While Not cRet Is Nothing And cRet.Address <> FirstAddress
End If
End With
Sheets("Sheet1").Columns("B").TextToColumns Destination:=Range("B2"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Comma:=True, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End Sub


Regards
Claus B.
 
Hi Nila,

Am Sat, 7 Jun 2014 08:06:59 +0200 schrieb Claus Busch:
here is another suggestion that is easier to read and understand:

Sub Sort()
Dim cRet As Range, rngS As Range
Dim LRow As Long, myCnt As Long, First As Long
Dim FirstAddress As String
Dim ArrIn As Variant

'Modify source sheet name
With Sheets("Test")
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Set search range
Set rngS = .Range("A1:A" & LRow)
End With

'Modify target sheet name
With Sheets("Sheet1")
Set cRet = rngS.Find("##RETENTION_TIME", LookIn:=xlValues)
If Not cRet Is Nothing Then
FirstAddress = cRet.Address
Do
'Count of NPoints
myCnt = Trim(Mid(cRet.Offset(2, 0), _
InStr(cRet.Offset(2, 0), "=") + 1, 99))
'first empty row
First = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
First = IIf(First = 2, 1, First)
.Cells(First, 1).Resize(rowsize:=myCnt) = _
Trim(Mid(cRet, InStr(cRet, "=") + 1, 99))
ArrIn = cRet.Offset(4, 0).Resize(rowsize:=myCnt)
.Cells(First, 2).Resize(rowsize:=myCnt) = ArrIn
Set cRet = rngS.FindNext(cRet)
Loop While Not cRet Is Nothing And cRet.Address <> FirstAddress
End If
.Columns("B").TextToColumns Destination:=Range("B1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Comma:=True, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End With
End Sub


Regards
Claus B.
 
Hello Everyone,



I need to do the following functions using excel vba



1. Ask user to select the text file using userform

2. Load the text file into excel (delimit by ',' and '=') - (sheet name :test)

3. Delete first 14 lines

4. Create a new sheet -( sheet name : sheet2)

5. Search file for ##RETENTION_TIME and ##NPOINTS, Copy the value of ##RETENTION_TIME to the new sheet (sheet1) based on ##NPOINTS. E.g: If ##RETENTION_TIME = 0.6 and ##NPOINTS = 10. 0.6 should be copied to cells from A1 to A10 in the sheet1. This should be repeated until it reaches the last row.



Following is the source code I have return for the above functionality. The code works fine till step 4. Step 5 is done by "sub sort". This is whereI am getting a compile error "Sub or function not defined". I am new to excel vba, I am not able to narrow down the issue further. Could anyone help me on this issue please? TIA.

Code

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Dim fileOpen As Variant



fileOpen = Application.GetOpenFilename("All Files(*.*),*.*")

If fileOpen = False Then Exit Sub

Workbooks.OpenText (fileOpen)

Range("A1").Select

Rows("1:14").Select

Selection.Delete Shift:=xlUp

Columns("A:A").Select

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _

Semicolon:=False, Comma:=True, Space:=False, Other:=True,OtherChar:= _

"=", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True



Call sort



Close fileOpen

ActiveWindow.Close False

Application.ScreenUpdating = True



End Sub



Sub sort()



Dim x As Integer

Dim y As Integer

Dim erow As Long



y = 10

x = 2

Sheets.Add after:=Sheets(Sheets.Count)

Do While Cells(1, x) <> ""

If Cells(1, x) = "##RETENTION_TIME" Then

Worsksheets("test").cell(1, x).Copy

Worksheets("sheet1").Activate

erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Paste destindation:=Worksheets("sheet1").Range("erow" & ":"& "A" & "y")

End If

Worksheets("test").Activate

x = x + 1

Loop



End Sub

Thanks Gary and Claus, but still i am not able resolve the issue. Please find the input and output files here. Both of them are sample files the file might contain more than 10K data.

input
https://drive.google.com/file/d/0B7SK8wSQ78atOExHQVBoWkZEZVU/edit?usp=sharing

output

https://docs.google.com/spreadsheet/ccc?key=0ArSK8wSQ78atdGdiSWJVZVZQTXZWd0RXTXN4Zl9oLUE&usp=sharing
https://drive.google.com/file/d/0B7SK8wSQ78atc0N0TXlqc2FPeDg/edit?usp=sharing
 
Good stuff!!

Try this in a standard module...

Option Explicit

Sub Parse_ScanFile()
' Parses XY data from a scan file
Dim sFile$, vData, saDataOut$(), v1, v2
Dim n&, j&, k&, MaxCols&

sFile = Application.GetOpenFilename
If sFile = "False" Then Exit Sub '//user cancels
vData = Split(ReadTextFile(sFile), vbCrLf)

'Load the header row
ReDim Preserve saDataOut(j)
saDataOut(j) = "RET,Value1,Value2": j = j + 1

'Iterate each block of scan data
For n = 14 To UBound(vData) - 15 Step 15
v1 = Split(vData(n + 1), "= ")
v2 = Split(vData(n + 3), "= ")
If v2(1) = "10" Then
For k = 5 To 14
ReDim Preserve saDataOut(j)
saDataOut(j) = v1(1) & "," & vData(n + k): j = j + 1
Next 'k
End If 'v2="10"
Next 'n

'Transfer output data to a 2D 1-based array
vData = saDataOut: Erase saDataOut
MaxCols = UBound(Split(vData(0), ",")) + 1
ReDim saDataOut(1 To UBound(vData) + 2, 1 To MaxCols)
For n = LBound(vData) To UBound(vData)
v1 = Split(vData(n), ",")
For k = LBound(v1) To UBound(v1)
saDataOut(n + 1, k + 1) = v1(k)
Next 'k
Next 'n
'Dump the data
Cells(1, 1).Resize(UBound(saDataOut), MaxCols) = saDataOut
End Sub

Function ReadTextFile$(Filename$)
' Reads large amounts of data from a text file in one single step.
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFile = Space$(LOF(iNum))
ReadTextFile = Input(LOF(iNum), iNum)

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFile()

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Oops! Change this...






TO



ReDim saDataOut(1 To UBound(vData) + 1, 1 To MaxCols)



--

Garry



Free usenet access at http://www.eternal-september.org

Classic VB Users Regroup!

comp.lang.basic.visual.misc

microsoft.public.vb.general.discussion

Thank you Garry. I have it working. But the excel is not producing data after 34,000 lines. I believe it is not reading larger text files completely. How can I change the code to read large text files?
 
Thank you Garry. I have it working. But the excel is not producing
data after 34,000 lines. I believe it is not reading larger text
files completely. How can I change the code to read large text files?

This is memory-dependant! In this case it's better to import the file
in 'blocks' first, then output to the worksheet block by block. (Now
you see why having the original final was important)

You can open the file in Excel directly so the data is on a worksheet
as per your example...


Sub Parse_ScanFile()
' Parses data from a scan file based on specified criteria
Dim sFile$, vData, saDataOut$(), v1, v2
Dim n&, j&, k&, MaxCols&
Dim wksTarget As Worksheet

Const sCriteria$ = "10": Const sColHdrs$ = "RET Time,Value1,Value2"

sFile = Application.GetOpenFilename
If sFile = "False" Then Exit Sub '//user cancels
Workbooks.OpenText Filename:=sFile, Origin:=xlMSDOS, StartRow:=1

'Load the header row
vData = ActiveSheet.UsedRange
ReDim Preserve saDataOut(j): saDataOut(j) = sColHdrs: j = j + 1

'Iterate each block of scan data
For n = 15 To UBound(vData) - 15 Step 15
v1 = Split(vData(n + 1, 1), "= ")
v2 = Split(vData(n + 3, 1), "= ")
If v2(1) = sCriteria Then
For k = 5 To 14
ReDim Preserve saDataOut(j)
saDataOut(j) = v1(1) & "," & vData(n + k, 1): j = j + 1
Next 'k
End If 'v2="10"
Next 'n

'Transfer output data to a 2D 1-based array
vData = saDataOut: Erase saDataOut
MaxCols = UBound(Split(vData(0), ",")) + 1
ReDim saDataOut(1 To UBound(vData) + 1, 1 To MaxCols)
For n = LBound(vData) To UBound(vData)
v1 = Split(vData(n), ",")
For k = LBound(v1) To UBound(v1)
saDataOut(n + 1, k + 1) = v1(k)
Next 'k
Next 'n
'Dump the data
Set wksTarget = Sheets.Add
wksTarget.Cells(1, 1).Resize(UBound(saDataOut), MaxCols) = saDataOut
End Sub

...where there is no need for 'ReadTextFile' since the original file
data is already on Sheets(1). Note that I do not delete Rows(1:14)
(simply as a 'good practice') in order to keep the original file data
intact.

If the memory issue persists then use...


Sub Parse_ScanFile2()
' Parses data from a scan file based on specified criteria
Dim sFile$, v1, v2, n&, k&
Dim lMaxCols&, lMaxRows&, lNextRow&
Dim wksSource As Worksheet, wksTarget As Worksheet

Const sCriteria$ = "10": Const sColHdrs$ = "RET Time,Value1,Value2"

sFile = Application.GetOpenFilename
If sFile = "False" Then Exit Sub '//user cancels

Application.ScreenUpdating = False
Workbooks.OpenText Filename:=sFile, Origin:=xlMSDOS, StartRow:=1

'Get fully qualified refs
Set wksSource = ActiveSheet: Set wksTarget = Sheets.Add
'Place the headers
v1 = Split(sColHdrs, ",")
wksTarget.Cells(1, 1).Resize(1, UBound(v1) + 1) = v1
'Initialize vars
lMaxRows = wksSource.UsedRange.Rows.Count
lMaxCols = wksTarget.UsedRange.Columns.Count

'Parse the data
lNextRow = 2 '//data starts here
For n = 15 To lMaxRows Step 15
If n = lMaxRows Then Exit For
v1 = Split(wksSource.Cells(n + 1, 1), "= ")
v2 = Split(wksSource.Cells(n + 3, 1), "= ")
If v2(1) = sCriteria Then
For k = 5 To 14
With wksTarget.Cells(lNextRow, 1)
.Resize(1, lMaxCols) = _
Split((v1(1) & "," & wksSource.Cells(n + k, 1)), ",")
lNextRow = lNextRow + 1
End With 'wksTarget.Cells(lNextRow, 1)
Next 'k
End If 'v2 = "10"
Next 'n
Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
This is memory-dependant! In this case it's better to import the file
in 'blocks' first, then output to the worksheet block by block.

This gets more involved and so is why I diverted to working directly
with worksheet ranges because the row limit is as per Excel version! I
was going to limit the output array to each loop step but didn't see
much advantage since it's only 10 rows of data. Otherwise, if you'd
like an example just post back a request...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Thanks Gary and Claus. I got it working. Is it possible to convert the 3 column data into matrix grid. I tried using INDEX and MATCH as mentioned here.
http://exceltactics.com/vlookup-multiple-criteria-using-index-match/
but my data set will have more than 250 unique rows and more than 4000 unique columns or vice-verse. Is there an efficient way to achieve this? Ultimately I would like to plot the data as a surface plot.

Thanks in advance.
 
Thanks Gary and Claus. I got it working. Is it possible to convert
the 3 column data into matrix grid. I tried using INDEX and MATCH as
mentioned here.
http://exceltactics.com/vlookup-multiple-criteria-using-index-match/
but my data set will have more than 250 unique rows and more than
4000 unique columns or vice-verse. Is there an efficient way to
achieve this? Ultimately I would like to plot the data as a surface
plot.

I'm seeing this data as very much resembling the output log from some
sort of a data recorder, and so most I'm familiar with have their own
software for manipulating that data in various ways. Is this an option?

You could create an array of arrays to build the matrix, then transfer
that to a 2D array for output to a worksheet. I'm inclined to go the
4000 rows by 250 columns route, but either way will result a fairly
large load on system resources. Especially if you go the VLOOKUP route
what with that many formulas (4000*250=1M cells)!

Are you wanting a grid that contains 1 row only for each Retention Time
without duplicate values across the row?

Also, note that the parsing results are 'text' and so would need to be
reprocessed as Variant so they're useable as numeric values when they
land on the grid in order to 'plot' efficiently.

Also, how do you want the value pairs to be displayed in the grid?
Current parse returns each value to its own column and so your 1st
example re-parses to...

0.6:30.92:269:30.99:317:32.59:302:33.26:337...

...and so on.

Is this for '#NPOINTS= 10' only, or for all data? (An example of the
expected result would be nice to work with!)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
For clarity about the formatting being text, and requiring
re-processing...

Using a Variant array the output results like this...

RET Time Value1 Value2
0.6 30.92 269
0.6 30.99 317
0.6 32.59 302
0.6 33.26 337

...where all text is left-aligned and all numeric data is right-aligned.
The text results are like this...

RET Time Value1 Value2
0.600 30.92 269
0.600 30.99 317
0.600 32.59 302
0.600 33.26 337

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
I converted the text into number. The problem I am having is that, excel could not handle this 1M multiple VLOOKUPs. I am wondering is there a better way to do that.
 
I converted the text into number. The problem I am having is that,
excel could not handle this 1M multiple VLOOKUPs.

No surprise!

I am wondering is there a better way to do that.

Yes, as I explained. What I need is your criteria for building the grid
of *unique* data, in a sample file I can download from somewhere. It
needs 3 sheets: Sheet1 with original imported file; Sheet2 with 3
column list; Sheet3 with expected grid with notation (cell comments) if
criteria is not obvious!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Back
Top