| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Slight VBA Code Change required
Hi, I have this import routine to convert a text file with a certain
structure(below code, in first example.) The text structure changed just slightly in that there is no more empty line (with a space) between each block of information. (See way below, new email text structure.) This has adverse effects in the routine that it does not know now to loop through each block. I need a slight change in the "Case Else" section of the code below to start the next block of information. I am not familiar with VBA and its going way over my head. Thanks in advance, Eskimo Here is the code... Sub ConvertFile() Dim LCStart As Long Dim IQStart As Long Dim Lat1Start As Long Dim Lon1Start As Long Dim Lat2Start As Long Dim Lon2Start As Long Dim NbmesStart As Long Dim Nbmes2Start As Long Dim BestLevelStart As Long Dim PassDurStart As Long Dim NOPCStart As Long Dim CalcFreqStart As Long Dim AltStart As Long Dim Num1Start As Long Dim Num2Start As Long Dim Num3Start As Long Dim Num4Start As Long Dim LineIn As String Dim RecNo As Long Dim RecLine As Long Dim aryData As Variant Dim maxRecords As Long Dim recColumns As Long maxRecords = 17000 recColumns = 20 Worksheets("Raw Data").UsedRange.Offset(1, 0).Resize(maxRecords, recColumns).EntireRow.Delete aryData = Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords, recColumns) ChDrive Left(ActiveWorkbook.Path, 1) ChDir ActiveWorkbook.Path 'FName = Range("FName").Value Open Range("FName") For Input As #1 RecNo = 2 RecLine = 0 Do While Not EOF(1) ' Loop until end of file. Line Input #1, LineIn ' Read line into variable. RecLine = RecLine + 1 Select Case RecLine Case 1 LCStart = WorksheetFunction.Find("LC :", LineIn) IQStart = WorksheetFunction.Find("IQ :", LineIn) aryData(RecNo, 1) = Mid(LineIn, 2, 5) aryData(RecNo, 2) = WorksheetFunction.Substitute(Mid(LineIn, 15, 8), ".", "/") aryData(RecNo, 3) = TimeValue(Mid(LineIn, 24, 8)) aryData(RecNo, 4) = Trim(Mid(LineIn, LCStart + 4, IQStart - (LCStart + 4))) aryData(RecNo, 5) = Trim(Mid(LineIn, IQStart + 4)) Case 2 Lat1Start = WorksheetFunction.Find("Lat1 :", LineIn) Lat2Start = WorksheetFunction.Find("Lat2 :", LineIn) Lon1Start = WorksheetFunction.Find("Lon1 :", LineIn) Lon2Start = WorksheetFunction.Find("Lon2 :", LineIn) aryData(RecNo, 6) = Trim(Mid(LineIn, Lat1Start + 6, Lon1Start - (Lat1Start + 6))) aryData(RecNo, 7) = Trim(Mid(LineIn, Lon1Start + 6, Lat2Start - (Lon1Start + 6))) aryData(RecNo, 8) = Trim(Mid(LineIn, Lat2Start + 6, Lon2Start - (Lat2Start + 6))) aryData(RecNo, 9) = Trim(Mid(LineIn, Lon2Start + 6)) Case 3 NbmesStart = WorksheetFunction.Find("Nb mes :", LineIn) Nbmes2Start = WorksheetFunction.Find("Nb mes-120dB :", LineIn) BestLevelStart = WorksheetFunction.Find("Best level :", LineIn) aryData(RecNo, 10) = Trim(Mid(LineIn, NbmesStart + 8, Nbmes2Start - (NbmesStart + 8))) aryData(RecNo, 11) = Trim(Mid(LineIn, Nbmes2Start + 15, BestLevelStart - (Nbmes2Start + 15))) aryData(RecNo, 12) = Trim(Mid(LineIn, BestLevelStart + 12)) Case 4 PassDurStart = WorksheetFunction.Find("Pass duration :", LineIn) NOPCStart = WorksheetFunction.Find("NOPC :", LineIn) aryData(RecNo, 13) = Trim(Mid(LineIn, PassDurStart + 15, NOPCStart - (PassDurStart + 15))) aryData(RecNo, 14) = Trim(Mid(LineIn, NOPCStart + 6)) Case 5 CalcFreqStart = WorksheetFunction.Find("Calcul freq :", LineIn) AltStart = WorksheetFunction.Find("Altitude :", LineIn) aryData(RecNo, 15) = Trim(Mid(LineIn, CalcFreqStart + 13, AltStart - (CalcFreqStart + 13))) aryData(RecNo, 16) = Trim(Mid(LineIn, AltStart + 10)) Case 6 Num1Start = WorksheetFunction.Find(" ", LineIn, 2) Num2Start = WorksheetFunction.Find(" ", LineIn, Num1Start + 1) Num3Start = WorksheetFunction.Find(" ", LineIn, Num2Start + 1) Num4Start = WorksheetFunction.Find(" ", LineIn, Num3Start + 1) aryData(RecNo, 17) = Trim(Mid(LineIn, Num1Start + 1, Num2Start - (Num1Start + 1))) aryData(RecNo, 18) = Trim(Mid(LineIn, Num2Start + 1, Num3Start - (Num2Start + 1))) aryData(RecNo, 19) = Trim(Mid(LineIn, Num3Start + 1, Num4Start - (Num3Start + 1))) aryData(RecNo, 20) = Trim(Mid(LineIn, Num4Start + 1)) Case Else If LineIn = " " Then RecLine = 0 RecNo = RecNo + 1 Else MsgBox "Record number " & RecNo & " (collar number " & aryData(RecNo, 1) & _ ")" & Chr(10) & "has this additional line:" & _ Chr(10) & Chr(10) & LineIn, vbInformation, "Please note" End If End Select Loop Close Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords, recColumns) = aryData Worksheets("Raw Data").UsedRange.Offset(RecNo, 0).Resize(maxRecords + 1 - RecNo).EntireRow.Delete End Sub Here below is the way it use to be...note the space in the empty line between each block. 06979 Date : 26.11.04 13:18:02 LC : 0 IQ : 40 Lat1 : 65.607N Lon1 : 103.130W Lat2 : 66.861N Lon2 : 110.355W Nb mes : 006 Nb mes-120dB : 000 Best level : -132 dB Pass duration : 483s NOPC : 2 Calcul freq : 401 649301.8 Hz Altitude : 144 m 00 2991 00 11 06979 Date : 26.11.04 14:09:13 LC : B IQ : 00 Lat1 : 65.503N Lon1 : 103.237W Lat2 : 54.304N Lon2 : 41.614W Nb mes : 002 Nb mes-120dB : 000 Best level : -133 dB Pass duration : 138s NOPC : 2 Calcul freq : 401 649301.8 Hz Altitude : 0 m 00 2465 00 11 06979 Date : 26.11.04 14:09:48 LC : 0 IQ : 46 Lat1 : 65.586N Lon1 : 102.939W Lat2 : 64.211N Lon2 : 95.011W Nb mes : 007 Nb mes-120dB : 000 Best level : -130 dB Pass duration : 483s NOPC : 2 Calcul freq : 401 649352.1 Hz Altitude : 134 m 00 2352 00 11 Here below is how the emails are now. note the lack of an empty line between each blcok as compared with that above. 06976 Date : 03.03.05 13:28:16 LC : 0 IQ : 50 Lat1 : 65.285N Lon1 : 100.524W Lat2 : 68.146N Lon2 : 115.915W Nb mes : 004 Nb mes-120dB : 000 Best level : -129 dB Pass duration : 462s NOPC : 2 Calcul freq : 401 651572.3 Hz Altitude : 138 m 00 70 00 235 06976 Date : 03.03.05 14:12:16 LC : Z IQ : 00 Lat1 : ??????? Lon1 : ???????? Lat2 : ??????? Lon2 : ???????? Nb mes : 009 Nb mes-120dB : 000 Best level : -128 dB Pass duration : 594s NOPC : 0 Calcul freq : 401 650000.0 Hz Altitude : 0 m 00 54 55 235 06976 Date : 03.03.05 14:26:34 LC : 0 IQ : 53 Lat1 : 65.317N Lon1 : 100.425W Lat2 : 82.934N Lon2 : 141.492E Nb mes : 006 Nb mes-120dB : 000 Best level : -130 dB Pass duration : 594s NOPC : 3 Calcul freq : 401 651187.5 Hz Altitude : 137 m 00 52 02 235 Any suggestions? Eskimo |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Slight VBA Code Change required
Change
RecLine = RecLine + 1 to RecLine = RecLine + 1 if RecLine 6 then RecLine = 1 If you might have extra lines in an block, then you would have to add further checks to see if the line contains the outdented number or is an extra line. -- Regards, Tom Ogilvy "Eskimo" wrote: Hi, I have this import routine to convert a text file with a certain structure(below code, in first example.) The text structure changed just slightly in that there is no more empty line (with a space) between each block of information. (See way below, new email text structure.) This has adverse effects in the routine that it does not know now to loop through each block. I need a slight change in the "Case Else" section of the code below to start the next block of information. I am not familiar with VBA and its going way over my head. Thanks in advance, Eskimo Here is the code... Sub ConvertFile() Dim LCStart As Long Dim IQStart As Long Dim Lat1Start As Long Dim Lon1Start As Long Dim Lat2Start As Long Dim Lon2Start As Long Dim NbmesStart As Long Dim Nbmes2Start As Long Dim BestLevelStart As Long Dim PassDurStart As Long Dim NOPCStart As Long Dim CalcFreqStart As Long Dim AltStart As Long Dim Num1Start As Long Dim Num2Start As Long Dim Num3Start As Long Dim Num4Start As Long Dim LineIn As String Dim RecNo As Long Dim RecLine As Long Dim aryData As Variant Dim maxRecords As Long Dim recColumns As Long maxRecords = 17000 recColumns = 20 Worksheets("Raw Data").UsedRange.Offset(1, 0).Resize(maxRecords, recColumns).EntireRow.Delete aryData = Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords, recColumns) ChDrive Left(ActiveWorkbook.Path, 1) ChDir ActiveWorkbook.Path 'FName = Range("FName").Value Open Range("FName") For Input As #1 RecNo = 2 RecLine = 0 Do While Not EOF(1) ' Loop until end of file. Line Input #1, LineIn ' Read line into variable. RecLine = RecLine + 1 Select Case RecLine Case 1 LCStart = WorksheetFunction.Find("LC :", LineIn) IQStart = WorksheetFunction.Find("IQ :", LineIn) aryData(RecNo, 1) = Mid(LineIn, 2, 5) aryData(RecNo, 2) = WorksheetFunction.Substitute(Mid(LineIn, 15, 8), ".", "/") aryData(RecNo, 3) = TimeValue(Mid(LineIn, 24, 8)) aryData(RecNo, 4) = Trim(Mid(LineIn, LCStart + 4, IQStart - (LCStart + 4))) aryData(RecNo, 5) = Trim(Mid(LineIn, IQStart + 4)) Case 2 Lat1Start = WorksheetFunction.Find("Lat1 :", LineIn) Lat2Start = WorksheetFunction.Find("Lat2 :", LineIn) Lon1Start = WorksheetFunction.Find("Lon1 :", LineIn) Lon2Start = WorksheetFunction.Find("Lon2 :", LineIn) aryData(RecNo, 6) = Trim(Mid(LineIn, Lat1Start + 6, Lon1Start - (Lat1Start + 6))) aryData(RecNo, 7) = Trim(Mid(LineIn, Lon1Start + 6, Lat2Start - (Lon1Start + 6))) aryData(RecNo, 8) = Trim(Mid(LineIn, Lat2Start + 6, Lon2Start - (Lat2Start + 6))) aryData(RecNo, 9) = Trim(Mid(LineIn, Lon2Start + 6)) Case 3 NbmesStart = WorksheetFunction.Find("Nb mes :", LineIn) Nbmes2Start = WorksheetFunction.Find("Nb mes-120dB :", LineIn) BestLevelStart = WorksheetFunction.Find("Best level :", LineIn) aryData(RecNo, 10) = Trim(Mid(LineIn, NbmesStart + 8, Nbmes2Start - (NbmesStart + 8))) aryData(RecNo, 11) = Trim(Mid(LineIn, Nbmes2Start + 15, BestLevelStart - (Nbmes2Start + 15))) aryData(RecNo, 12) = Trim(Mid(LineIn, BestLevelStart + 12)) Case 4 PassDurStart = WorksheetFunction.Find("Pass duration :", LineIn) NOPCStart = WorksheetFunction.Find("NOPC :", LineIn) aryData(RecNo, 13) = Trim(Mid(LineIn, PassDurStart + 15, NOPCStart - (PassDurStart + 15))) aryData(RecNo, 14) = Trim(Mid(LineIn, NOPCStart + 6)) Case 5 CalcFreqStart = WorksheetFunction.Find("Calcul freq :", LineIn) AltStart = WorksheetFunction.Find("Altitude :", LineIn) aryData(RecNo, 15) = Trim(Mid(LineIn, CalcFreqStart + 13, AltStart - (CalcFreqStart + 13))) aryData(RecNo, 16) = Trim(Mid(LineIn, AltStart + 10)) Case 6 Num1Start = WorksheetFunction.Find(" ", LineIn, 2) Num2Start = WorksheetFunction.Find(" ", LineIn, Num1Start + 1) Num3Start = WorksheetFunction.Find(" ", LineIn, Num2Start + 1) Num4Start = WorksheetFunction.Find(" ", LineIn, Num3Start + 1) aryData(RecNo, 17) = Trim(Mid(LineIn, Num1Start + 1, Num2Start - (Num1Start + 1))) aryData(RecNo, 18) = Trim(Mid(LineIn, Num2Start + 1, Num3Start - (Num2Start + 1))) aryData(RecNo, 19) = Trim(Mid(LineIn, Num3Start + 1, Num4Start - (Num3Start + 1))) aryData(RecNo, 20) = Trim(Mid(LineIn, Num4Start + 1)) Case Else If LineIn = " " Then RecLine = 0 RecNo = RecNo + 1 Else MsgBox "Record number " & RecNo & " (collar number " & aryData(RecNo, 1) & _ ")" & Chr(10) & "has this additional line:" & _ Chr(10) & Chr(10) & LineIn, vbInformation, "Please note" End If End Select Loop Close Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords, recColumns) = aryData Worksheets("Raw Data").UsedRange.Offset(RecNo, 0).Resize(maxRecords + 1 - RecNo).EntireRow.Delete End Sub Here below is the way it use to be...note the space in the empty line between each block. 06979 Date : 26.11.04 13:18:02 LC : 0 IQ : 40 Lat1 : 65.607N Lon1 : 103.130W Lat2 : 66.861N Lon2 : 110.355W Nb mes : 006 Nb mes-120dB : 000 Best level : -132 dB Pass duration : 483s NOPC : 2 Calcul freq : 401 649301.8 Hz Altitude : 144 m 00 2991 00 11 06979 Date : 26.11.04 14:09:13 LC : B IQ : 00 Lat1 : 65.503N Lon1 : 103.237W Lat2 : 54.304N Lon2 : 41.614W Nb mes : 002 Nb mes-120dB : 000 Best level : -133 dB Pass duration : 138s NOPC : 2 Calcul freq : 401 649301.8 Hz Altitude : 0 m 00 2465 00 11 06979 Date : 26.11.04 14:09:48 LC : 0 IQ : 46 Lat1 : 65.586N Lon1 : 102.939W Lat2 : 64.211N Lon2 : 95.011W Nb mes : 007 Nb mes-120dB : 000 Best level : -130 dB Pass duration : 483s NOPC : 2 Calcul freq : 401 649352.1 Hz Altitude : 134 m 00 2352 00 11 Here below is how the emails are now. note the lack of an empty line between each blcok as compared with that above. 06976 Date : 03.03.05 13:28:16 LC : 0 IQ : 50 Lat1 : 65.285N Lon1 : 100.524W Lat2 : 68.146N Lon2 : 115.915W Nb mes : 004 Nb mes-120dB : 000 Best level : -129 dB Pass duration : 462s NOPC : 2 Calcul freq : 401 651572.3 Hz Altitude : 138 m 00 70 00 235 06976 Date : 03.03.05 14:12:16 LC : Z IQ : 00 Lat1 : ??????? Lon1 : ???????? Lat2 : ??????? Lon2 : ???????? Nb mes : 009 Nb mes-120dB : 000 Best level : -128 dB Pass duration : 594s NOPC : 0 Calcul freq : 401 650000.0 Hz Altitude : 0 m 00 54 55 235 06976 Date : 03.03.05 14:26:34 LC : 0 IQ : 53 Lat1 : 65.317N Lon1 : 100.425W Lat2 : 82.934N Lon2 : 141.492E Nb mes : 006 Nb mes-120dB : 000 Best level : -130 dB Pass duration : 594s NOPC : 3 Calcul freq : 401 651187.5 Hz Altitude : 137 m 00 52 02 235 Any suggestions? Eskimo |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Slight VBA Code Change required
Hi Tom,
It didn't work, did the very same thing and gave me the message popping up from the code. Here is how the email text structure is now, the example in the first question has a blank line between pass and calc that should not be there. 06976 Date : 03.03.05 13:28:16 LC : 0 IQ : 50 Lat1 : 65.285N Lon1 : 100.524W Lat2 : 68.146N Lon2 : 115.915W Nb mes : 004 Nb mes-120dB : 000 Best level : -129 dB Pass duration : 462s NOPC : 2 Calcul freq : 401 651572.3 Hz Altitude : 138 m 00 70 00 235 06976 Date : 03.03.05 14:12:16 LC : Z IQ : 00 Lat1 : ??????? Lon1 : ???????? Lat2 : ??????? Lon2 : ???????? Nb mes : 009 Nb mes-120dB : 000 Best level : -128 dB Pass duration : 594s NOPC : 0 Calcul freq : 401 650000.0 Hz Altitude : 0 m 00 54 55 235 06976 Date : 03.03.05 14:26:34 LC : 0 IQ : 53 Lat1 : 65.317N Lon1 : 100.425W Lat2 : 82.934N Lon2 : 141.492E Nb mes : 006 Nb mes-120dB : 000 Best level : -130 dB Pass duration : 594s NOPC : 3 Calcul freq : 401 651187.5 Hz Altitude : 137 m 00 52 02 235 Eskimo "Tom Ogilvy" wrote: Change RecLine = RecLine + 1 to RecLine = RecLine + 1 if RecLine 6 then RecLine = 1 If you might have extra lines in an block, then you would have to add further checks to see if the line contains the outdented number or is an extra line. -- Regards, Tom Ogilvy "Eskimo" wrote: Hi, I have this import routine to convert a text file with a certain structure(below code, in first example.) The text structure changed just slightly in that there is no more empty line (with a space) between each block of information. (See way below, new email text structure.) This has adverse effects in the routine that it does not know now to loop through each block. I need a slight change in the "Case Else" section of the code below to start the next block of information. I am not familiar with VBA and its going way over my head. Thanks in advance, Eskimo Here is the code... Sub ConvertFile() Dim LCStart As Long Dim IQStart As Long Dim Lat1Start As Long Dim Lon1Start As Long Dim Lat2Start As Long Dim Lon2Start As Long Dim NbmesStart As Long Dim Nbmes2Start As Long Dim BestLevelStart As Long Dim PassDurStart As Long Dim NOPCStart As Long Dim CalcFreqStart As Long Dim AltStart As Long Dim Num1Start As Long Dim Num2Start As Long Dim Num3Start As Long Dim Num4Start As Long Dim LineIn As String Dim RecNo As Long Dim RecLine As Long Dim aryData As Variant Dim maxRecords As Long Dim recColumns As Long maxRecords = 17000 recColumns = 20 Worksheets("Raw Data").UsedRange.Offset(1, 0).Resize(maxRecords, recColumns).EntireRow.Delete aryData = Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords, recColumns) ChDrive Left(ActiveWorkbook.Path, 1) ChDir ActiveWorkbook.Path 'FName = Range("FName").Value Open Range("FName") For Input As #1 RecNo = 2 RecLine = 0 Do While Not EOF(1) ' Loop until end of file. Line Input #1, LineIn ' Read line into variable. RecLine = RecLine + 1 Select Case RecLine Case 1 LCStart = WorksheetFunction.Find("LC :", LineIn) IQStart = WorksheetFunction.Find("IQ :", LineIn) aryData(RecNo, 1) = Mid(LineIn, 2, 5) aryData(RecNo, 2) = WorksheetFunction.Substitute(Mid(LineIn, 15, 8), ".", "/") aryData(RecNo, 3) = TimeValue(Mid(LineIn, 24, 8)) aryData(RecNo, 4) = Trim(Mid(LineIn, LCStart + 4, IQStart - (LCStart + 4))) aryData(RecNo, 5) = Trim(Mid(LineIn, IQStart + 4)) Case 2 Lat1Start = WorksheetFunction.Find("Lat1 :", LineIn) Lat2Start = WorksheetFunction.Find("Lat2 :", LineIn) Lon1Start = WorksheetFunction.Find("Lon1 :", LineIn) Lon2Start = WorksheetFunction.Find("Lon2 :", LineIn) aryData(RecNo, 6) = Trim(Mid(LineIn, Lat1Start + 6, Lon1Start - (Lat1Start + 6))) aryData(RecNo, 7) = Trim(Mid(LineIn, Lon1Start + 6, Lat2Start - (Lon1Start + 6))) aryData(RecNo, 8) = Trim(Mid(LineIn, Lat2Start + 6, Lon2Start - (Lat2Start + 6))) aryData(RecNo, 9) = Trim(Mid(LineIn, Lon2Start + 6)) Case 3 NbmesStart = WorksheetFunction.Find("Nb mes :", LineIn) Nbmes2Start = WorksheetFunction.Find("Nb mes-120dB :", LineIn) BestLevelStart = WorksheetFunction.Find("Best level :", LineIn) aryData(RecNo, 10) = Trim(Mid(LineIn, NbmesStart + 8, Nbmes2Start - (NbmesStart + 8))) aryData(RecNo, 11) = Trim(Mid(LineIn, Nbmes2Start + 15, BestLevelStart - (Nbmes2Start + 15))) aryData(RecNo, 12) = Trim(Mid(LineIn, BestLevelStart + 12)) Case 4 PassDurStart = WorksheetFunction.Find("Pass duration :", LineIn) NOPCStart = WorksheetFunction.Find("NOPC :", LineIn) aryData(RecNo, 13) = Trim(Mid(LineIn, PassDurStart + 15, NOPCStart - (PassDurStart + 15))) aryData(RecNo, 14) = Trim(Mid(LineIn, NOPCStart + 6)) Case 5 CalcFreqStart = WorksheetFunction.Find("Calcul freq :", LineIn) AltStart = WorksheetFunction.Find("Altitude :", LineIn) aryData(RecNo, 15) = Trim(Mid(LineIn, CalcFreqStart + 13, AltStart - (CalcFreqStart + 13))) aryData(RecNo, 16) = Trim(Mid(LineIn, AltStart + 10)) Case 6 Num1Start = WorksheetFunction.Find(" ", LineIn, 2) Num2Start = WorksheetFunction.Find(" ", LineIn, Num1Start + 1) Num3Start = WorksheetFunction.Find(" ", LineIn, Num2Start + 1) Num4Start = WorksheetFunction.Find(" ", LineIn, Num3Start + 1) aryData(RecNo, 17) = Trim(Mid(LineIn, Num1Start + 1, Num2Start - (Num1Start + 1))) aryData(RecNo, 18) = Trim(Mid(LineIn, Num2Start + 1, Num3Start - (Num2Start + 1))) aryData(RecNo, 19) = Trim(Mid(LineIn, Num3Start + 1, Num4Start - (Num3Start + 1))) aryData(RecNo, 20) = Trim(Mid(LineIn, Num4Start + 1)) Case Else If LineIn = " " Then RecLine = 0 RecNo = RecNo + 1 Else MsgBox "Record number " & RecNo & " (collar number " & aryData(RecNo, 1) & _ ")" & Chr(10) & "has this additional line:" & _ Chr(10) & Chr(10) & LineIn, vbInformation, "Please note" End If End Select Loop Close Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords, recColumns) = aryData Worksheets("Raw Data").UsedRange.Offset(RecNo, 0).Resize(maxRecords + 1 - RecNo).EntireRow.Delete End Sub Here below is the way it use to be...note the space in the empty line between each block. 06979 Date : 26.11.04 13:18:02 LC : 0 IQ : 40 Lat1 : 65.607N Lon1 : 103.130W Lat2 : 66.861N Lon2 : 110.355W Nb mes : 006 Nb mes-120dB : 000 Best level : -132 dB Pass duration : 483s NOPC : 2 Calcul freq : 401 649301.8 Hz Altitude : 144 m 00 2991 00 11 06979 Date : 26.11.04 14:09:13 LC : B IQ : 00 Lat1 : 65.503N Lon1 : 103.237W Lat2 : 54.304N Lon2 : 41.614W Nb mes : 002 Nb mes-120dB : 000 Best level : -133 dB Pass duration : 138s NOPC : 2 Calcul freq : 401 649301.8 Hz Altitude : 0 m 00 2465 00 11 06979 Date : 26.11.04 14:09:48 LC : 0 IQ : 46 Lat1 : 65.586N Lon1 : 102.939W Lat2 : 64.211N Lon2 : 95.011W Nb mes : 007 Nb mes-120dB : 000 Best level : -130 dB Pass duration : 483s NOPC : 2 Calcul freq : 401 649352.1 Hz Altitude : 134 m 00 2352 00 11 Here below is how the emails are now. note the lack of an empty line between each blcok as compared with that above. 06976 Date : 03.03.05 13:28:16 LC : 0 IQ : 50 Lat1 : 65.285N Lon1 : 100.524W Lat2 : 68.146N Lon2 : 115.915W Nb mes : 004 Nb mes-120dB : 000 Best level : -129 dB Pass duration : 462s NOPC : 2 Calcul freq : 401 651572.3 Hz Altitude : 138 m 00 70 00 235 06976 Date : 03.03.05 14:12:16 LC : Z IQ : 00 Lat1 : ??????? Lon1 : ???????? Lat2 : ??????? Lon2 : ???????? Nb mes : 009 Nb mes-120dB : 000 Best level : -128 dB Pass duration : 594s NOPC : 0 Calcul freq : 401 650000.0 Hz Altitude : 0 m 00 54 55 235 06976 Date : 03.03.05 14:26:34 LC : 0 IQ : 53 Lat1 : 65.317N Lon1 : 100.425W Lat2 : 82.934N Lon2 : 141.492E Nb mes : 006 Nb mes-120dB : 000 Best level : -130 dB Pass duration : 594s NOPC : 3 Calcul freq : 401 651187.5 Hz Altitude : 137 m 00 52 02 235 Any suggestions? Eskimo |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Slight VBA Code Change required
I should have checked first where your suggestion told me to make the changes
within the code. I was so caught up in the Case Else Section, that I placed your suggestion in the bottom rather than on the top portion of the code where you suggested. I tried it, however, it gave me only one line in the raw data sheet (the resulting sheet from the code) I think we need to re-do the case else section also, with the addition of your suggestion. There are no more empty lines with a " " anywhere in between each block so I think that needs to be eliminated. But how? Thank you kindly for your help. Your name sounds very familiar. Have you helped me with this code before? "Tom Ogilvy" wrote: Change RecLine = RecLine + 1 to RecLine = RecLine + 1 if RecLine 6 then RecLine = 1 If you might have extra lines in an block, then you would have to add further checks to see if the line contains the outdented number or is an extra line. -- Regards, Tom Ogilvy "Eskimo" wrote: Hi, I have this import routine to convert a text file with a certain structure(below code, in first example.) The text structure changed just slightly in that there is no more empty line (with a space) between each block of information. (See way below, new email text structure.) This has adverse effects in the routine that it does not know now to loop through each block. I need a slight change in the "Case Else" section of the code below to start the next block of information. I am not familiar with VBA and its going way over my head. Thanks in advance, Eskimo Here is the code... Sub ConvertFile() Dim LCStart As Long Dim IQStart As Long Dim Lat1Start As Long Dim Lon1Start As Long Dim Lat2Start As Long Dim Lon2Start As Long Dim NbmesStart As Long Dim Nbmes2Start As Long Dim BestLevelStart As Long Dim PassDurStart As Long Dim NOPCStart As Long Dim CalcFreqStart As Long Dim AltStart As Long Dim Num1Start As Long Dim Num2Start As Long Dim Num3Start As Long Dim Num4Start As Long Dim LineIn As String Dim RecNo As Long Dim RecLine As Long Dim aryData As Variant Dim maxRecords As Long Dim recColumns As Long maxRecords = 17000 recColumns = 20 Worksheets("Raw Data").UsedRange.Offset(1, 0).Resize(maxRecords, recColumns).EntireRow.Delete aryData = Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords, recColumns) ChDrive Left(ActiveWorkbook.Path, 1) ChDir ActiveWorkbook.Path 'FName = Range("FName").Value Open Range("FName") For Input As #1 RecNo = 2 RecLine = 0 Do While Not EOF(1) ' Loop until end of file. Line Input #1, LineIn ' Read line into variable. RecLine = RecLine + 1 Select Case RecLine Case 1 LCStart = WorksheetFunction.Find("LC :", LineIn) IQStart = WorksheetFunction.Find("IQ :", LineIn) aryData(RecNo, 1) = Mid(LineIn, 2, 5) aryData(RecNo, 2) = WorksheetFunction.Substitute(Mid(LineIn, 15, 8), ".", "/") aryData(RecNo, 3) = TimeValue(Mid(LineIn, 24, 8)) aryData(RecNo, 4) = Trim(Mid(LineIn, LCStart + 4, IQStart - (LCStart + 4))) aryData(RecNo, 5) = Trim(Mid(LineIn, IQStart + 4)) Case 2 Lat1Start = WorksheetFunction.Find("Lat1 :", LineIn) Lat2Start = WorksheetFunction.Find("Lat2 :", LineIn) Lon1Start = WorksheetFunction.Find("Lon1 :", LineIn) Lon2Start = WorksheetFunction.Find("Lon2 :", LineIn) aryData(RecNo, 6) = Trim(Mid(LineIn, Lat1Start + 6, Lon1Start - (Lat1Start + 6))) aryData(RecNo, 7) = Trim(Mid(LineIn, Lon1Start + 6, Lat2Start - (Lon1Start + 6))) aryData(RecNo, 8) = Trim(Mid(LineIn, Lat2Start + 6, Lon2Start - (Lat2Start + 6))) aryData(RecNo, 9) = Trim(Mid(LineIn, Lon2Start + 6)) Case 3 NbmesStart = WorksheetFunction.Find("Nb mes :", LineIn) Nbmes2Start = WorksheetFunction.Find("Nb mes-120dB :", LineIn) BestLevelStart = WorksheetFunction.Find("Best level :", LineIn) aryData(RecNo, 10) = Trim(Mid(LineIn, NbmesStart + 8, Nbmes2Start - (NbmesStart + 8))) aryData(RecNo, 11) = Trim(Mid(LineIn, Nbmes2Start + 15, BestLevelStart - (Nbmes2Start + 15))) aryData(RecNo, 12) = Trim(Mid(LineIn, BestLevelStart + 12)) Case 4 PassDurStart = WorksheetFunction.Find("Pass duration :", LineIn) NOPCStart = WorksheetFunction.Find("NOPC :", LineIn) aryData(RecNo, 13) = Trim(Mid(LineIn, PassDurStart + 15, NOPCStart - (PassDurStart + 15))) aryData(RecNo, 14) = Trim(Mid(LineIn, NOPCStart + 6)) Case 5 CalcFreqStart = WorksheetFunction.Find("Calcul freq :", LineIn) AltStart = WorksheetFunction.Find("Altitude :", LineIn) aryData(RecNo, 15) = Trim(Mid(LineIn, CalcFreqStart + 13, AltStart - (CalcFreqStart + 13))) aryData(RecNo, 16) = Trim(Mid(LineIn, AltStart + 10)) Case 6 Num1Start = WorksheetFunction.Find(" ", LineIn, 2) Num2Start = WorksheetFunction.Find(" ", LineIn, Num1Start + 1) Num3Start = WorksheetFunction.Find(" ", LineIn, Num2Start + 1) Num4Start = WorksheetFunction.Find(" ", LineIn, Num3Start + 1) aryData(RecNo, 17) = Trim(Mid(LineIn, Num1Start + 1, Num2Start - (Num1Start + 1))) aryData(RecNo, 18) = Trim(Mid(LineIn, Num2Start + 1, Num3Start - (Num2Start + 1))) aryData(RecNo, 19) = Trim(Mid(LineIn, Num3Start + 1, Num4Start - (Num3Start + 1))) aryData(RecNo, 20) = Trim(Mid(LineIn, Num4Start + 1)) Case Else If LineIn = " " Then RecLine = 0 RecNo = RecNo + 1 Else MsgBox "Record number " & RecNo & " (collar number " & aryData(RecNo, 1) & _ ")" & Chr(10) & "has this additional line:" & _ Chr(10) & Chr(10) & LineIn, vbInformation, "Please note" End If End Select Loop Close Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords, recColumns) = aryData Worksheets("Raw Data").UsedRange.Offset(RecNo, 0).Resize(maxRecords + 1 - RecNo).EntireRow.Delete End Sub Here below is the way it use to be...note the space in the empty line between each block. 06979 Date : 26.11.04 13:18:02 LC : 0 IQ : 40 Lat1 : 65.607N Lon1 : 103.130W Lat2 : 66.861N Lon2 : 110.355W Nb mes : 006 Nb mes-120dB : 000 Best level : -132 dB Pass duration : 483s NOPC : 2 Calcul freq : 401 649301.8 Hz Altitude : 144 m 00 2991 00 11 06979 Date : 26.11.04 14:09:13 LC : B IQ : 00 Lat1 : 65.503N Lon1 : 103.237W Lat2 : 54.304N Lon2 : 41.614W Nb mes : 002 Nb mes-120dB : 000 Best level : -133 dB Pass duration : 138s NOPC : 2 Calcul freq : 401 649301.8 Hz Altitude : 0 m 00 2465 00 11 06979 Date : 26.11.04 14:09:48 LC : 0 IQ : 46 Lat1 : 65.586N Lon1 : 102.939W Lat2 : 64.211N Lon2 : 95.011W Nb mes : 007 Nb mes-120dB : 000 Best level : -130 dB Pass duration : 483s NOPC : 2 Calcul freq : 401 649352.1 Hz Altitude : 134 m 00 2352 00 11 Here below is how the emails are now. note the lack of an empty line between each blcok as compared with that above. 06976 Date : 03.03.05 13:28:16 LC : 0 IQ : 50 Lat1 : 65.285N Lon1 : 100.524W Lat2 : 68.146N Lon2 : 115.915W Nb mes : 004 Nb mes-120dB : 000 Best level : -129 dB Pass duration : 462s NOPC : 2 Calcul freq : 401 651572.3 Hz Altitude : 138 m 00 70 00 235 06976 Date : 03.03.05 14:12:16 LC : Z IQ : 00 Lat1 : ??????? Lon1 : ???????? Lat2 : ??????? Lon2 : ???????? Nb mes : 009 Nb mes-120dB : 000 Best level : -128 dB Pass duration : 594s NOPC : 0 Calcul freq : 401 650000.0 Hz Altitude : 0 m 00 54 55 235 06976 Date : 03.03.05 14:26:34 LC : 0 IQ : 53 Lat1 : 65.317N Lon1 : 100.425W Lat2 : 82.934N Lon2 : 141.492E Nb mes : 006 Nb mes-120dB : 000 Best level : -130 dB Pass duration : 594s NOPC : 3 Calcul freq : 401 651187.5 Hz Altitude : 137 m 00 52 02 235 Any suggestions? Eskimo |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Slight VBA Code Change required
|
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Another VB Code Required | Excel Discussion (Misc queries) | |||
| VB Code Required | Excel Discussion (Misc queries) | |||
| Slight Error in my Simple code | Excel Programming | |||
| Need a slight modification to code | Excel Programming | |||
| Code required please | Excel Programming | |||
Hybrid Mode
