write to next 27 lines

[leena24]

Hi !

I am writing a macro , which can help me write next 27 lines once a condition is fulfilled.

for e.g.

"If Trim((Mid(data, 12, 5))) = chk1 Then "

so what i need is that if data = 'chk1' , then extract subsequent 27 lines from chk1 in a different text file.

Any Ideas ?

 

[ravishankar]

Hi
Your message is not clear. Assuming that you are looking for chk1 as a part of string in col A , paste the following codes in the macro window (Alt f11)

Sub ggg()
x = Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To x
b = Cells(a, 1)
If InStr(b, "chk1") > 0 Then
c = a & ":" & a + 27
Rows(c).Copy
Cells(x + 3, 1).PasteSpecial
Exit For
End If
Next a
End Sub

Run the macro. It will copy 27 rows from where it finds chk1 and pastes it 3 rows below last row of data.
Ravi

 

[leena24]

Hi
i am reading it from a text file. and i have to extract the lines into another text file.
thanks

 

[jindon]

try

Sub test()
Dim myDir As string, fn As String, fnNew As String, chk1 As String
Dim txt As String, temp As String, ff As Integer, n As Long, flg As Boolean
chk1 = "blahblah"
myDir = "C\:test"
fn = "\test1.txt"
ff = freeFile
Open myDir & fn For Input As #ff
Do Until EOF(ff)
     Line Input #ff, txt
     If Trim(txt) = chk1 Then
          msg = txt
          Do Until EOF(ff)
               Line Input #ff, txt
               n = n + 1
               If n < 27 Then
                    temp = temp & vbCrLf & txt
               Else
                    flg = True : Exit Do
               End If
           Loop
     End If
     If flg = True Then Exit Do
Loop
Close #ff
If Len(temp) = 0 Then Exit Sub
ff = FreeFile
fnNew = "\test2.txt"
Open myDir & fnNew For Output As #ff
     Print #ff, temp
Close #ff
End Sub

 

[leena24]

Hi Jindon

How have you been ?

running perfectly but for two issues:-
'it is not extracting the line where it found chk1 .
'chk1 can have multiple values so it has to read the entire file till end and take out data from Mypos.

chk1 = Trim(Mid(data, 12, 4))
Mypos = InStr(chk1, "001") Xor InStr(chk1, "002") Xor InStr(chk1, "400") Xor InStr(chk1, "160")

If Mypos > 0 Then

( I have added your code after this )

*** also like to mention that , the text file from where the data is being read is really huge like 600 mb .

Thanks again

 

[jindon]

Hi
I'm very well, thanks. Hope you are well, too.
chk1 = Trim(Mid(txt,12,4)) means length of 4, while all your criteria have 3 length.
Not sure if this is alrgith or not.

Sub test()
Dim myDir As string, fn As String, fnNew As String, chk1 As String
Dim txt As String, temp As String, ff As Integer, n As Long
myDir = "C\:test"
fn = "\test1.txt"
ff = freeFile
Open myDir & fn For Input As #ff
Do Until EOF(ff)
     Line Input #ff, txt
     chk1 = Trim(Mid$(txt,12,4))
     Select Case chk1
          Case "001", "002", "400", "160"
               temp = txt
               Do Until EOF(ff)
                    Line Input #ff, txt
                    n = n + 1
                    If n < 27 Then
                         temp = temp & vbCrLf & txt
                    Else
                         Exit Do
                    End If
                Loop
     End Select
Loop
Close #ff
If Len(temp) = 0 Then Exit Sub
ff = FreeFile
fnNew = "\test2.txt"
Open myDir & fnNew For Output As #ff
     Print #ff, temp
Close #ff
End Sub

 

[leena24]

Thanks Jindon! It works as in, it is searching all the values in chk1 till the end of the file , however it is writing only the last line of the input file in the output file.

Thanks

 

[jindon]

Right, try this one

Sub test()
Dim myDir As string, fn As String, fnNew As String, chk1 As String
Dim txt As String, temp As String, ff As Integer, n As Long
myDir = "C\:test"
fn = "\test1.txt"
ff = freeFile
Open myDir & fn For Input As #ff
Do Until EOF(ff)
     Line Input #ff, txt
     chk1 = Trim(Mid$(txt,12,4))
     If n = 0 Then
          Select Case chk1
               Case "001", "002", "400", "160"
                    temp = txt
                    n = n + 1
          End Select
     Else
          temp = temp & vbCrLf & txt
          n = n + 1
          If n > 27 Then n = 0
     End If
Loop
Close #ff
If Len(temp) = 0 Then Exit Sub
ff = FreeFile
fnNew = "\test2.txt"
Open myDir & fnNew For Output As #ff
     Print #ff, temp
Close #ff
End Sub

 

[leena24]

ok ...now it is copying only the last 27 lines after the last instance of chk1 . It has to copy all 27 lines after each chk1 instance.

 

[jindon]

Arrrr

Can you just change

temp = txt

to

temp = temp & vbCrLf & txt

also

Print #ff, temp

to

Print #ff, Mid$(temp,2)