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 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.
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

On Friday, June 6, 2014 5:53:49 PM UTC-6, L. Howard wrote:
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

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

On Friday, June 6, 2014 11:25:39 PM UTC-6, Nila wrote:
On Friday, June 6, 2014 5:53:49 PM UTC-6, L. Howard wrote:

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



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

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.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Nila,

Am Sat, 7 Jun 2014 08:06:59 +0200 schrieb Claus Busch:

try:
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.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

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

On Friday, June 6, 2014 4:06:34 PM UTC-6, Nila wrote:
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 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.

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/0B7S...it?usp=sharing

output

https://docs.google.com/spreadsheet/...UE&usp=sharing
https://drive.google.com/file/d/0B7S...it?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...

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

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

On Tuesday, June 10, 2014 9:40:11 PM UTC-6, GS wrote:
Oops! Change this...



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



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?

Hi Naila,

Am Wed, 11 Jun 2014 00:56:55 -0700 (PDT) schrieb Nila:

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?

please have a look:
https://onedrive.live.com/?cid=9378A...121822A3%21326
for "Sort"


Regards
Claus B.

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