CODEWITHSUNDEEP
stringvbaexcel
VBAnovice
VBAnovice

Reputation: 21

copy found string 1 cell down

I hope you can help with a VBA problem I'm trying to solve.

My situation: I have multiple txt files as input for the search of a particular string ("tflux"). In every txt file the string is present so it is not possible that it is not found. I've written the code below, but I cannot find a way to tell excel that after copying the value that is related to the found string it has to move one cell lower for the next found value that is related to the next file it searches. Although I didn't try yet, I also would like excel to print the file name next to the numbers to be sure that the values correspond to a certain file name.

My VBA code so far:

  Sub CommandButton1_Click()

  Dim strF As String, strP As String, text As String, textline As String, tFlux As Integer
  strP = "C:\test" 'change for the path of your folder

  strF = Dir(strP & "\*.txt") 'Change as required

  Do While strF <> vbNullString

  Open strF For Input As #1
  Do Until EOF(1)

    Line Input #1, textline
    text = text & textline
    tFlux = InStr(text, "tflux")
    Range("B2").Value = Mid(text, tFlux + 9, 3) <----- this is the line where I need help, Now the last found value is copied into cell B2, but I want excel to move to B3 after filling B2, move to B4 after filling B3, etc....

Loop
Close #1
text = ""
strF = Dir()
Loop

End Sub

Upvotes: 1

Views: 73

Answers (3)

YowE3K
YowE3K

Reputation: 23994

I would recommend that you refactor your code as follows:

Sub CommandButton1_Click()

    Dim strF As String, strP As String, textline As String, tFlux As Integer
    Dim r As Long ' to keep track of which row we are writing to

    strP = "C:\test" 'change for the path of your folder
    strF = Dir(strP & "\*.txt") 'Change as required
    r = 2 ' first line of output will go to row 2

    Do While strF <> vbNullString

        Open strF For Input As #1
        Do Until EOF(1)    
            Line Input #1, textline
            tFlux = InStr(textline, "tflux")
            'See if we found "tflux"
            If tFlux > 0 Then
                'Found it - store the associated value
                Cells(r, "B").Value = Mid(textline, tFlux + 9, 3)
                'Store the filename too
                Cells(r, "C").Value = strF
                r = r + 1 ' set row pointer ready for next file
                Exit Do ' found and processed - no need to keep looking within this file
            End If
        Loop
        Close #1
        strF = Dir()
    Loop

End Sub

I included an Exit Do inside the "read file" loop so that, as soon as it finds the information you are looking for, it exits the loop. That saves time by not having to continue reading the rest of the file looking for something that you know won't be there.

Upvotes: 0

A.S.H
A.S.H

Reputation: 29352

The answer of VBA Pete will do the desired moving down for each found value. But I want to warn you about another, important problem in your code:

Line Input #1, textline

text = text & textline

tFlux = InStr(text, "tflux")

The above code has two problems. First, each time you read a line you append it to the previous text from the file, and you restart the search from the file's beginning. This is very slow, but moreover, it is wrong because if there are many occurrences of "tflux" in the file, you will always catch the first occurrence. Even if there is only one occurrence, you will catch it and report it many times each time you read a new line.

The second line of the above could should be rewritten this way:

text = textline ' <-- just copy the line, don't append it to previous lines from the file

Upvotes: 3

VBA Pete
VBA Pete

Reputation: 2666

How about a long variable that moves one value up in the range each time it runs through the loop:

Sub CommandButton1_Click()

Dim strF As String, strP As String, text As String, textline As String 
Dim tFlux As Integer strP = "C:\test" 'change for the path of your folder
Dim x as long

strF = Dir(strP & "*.txt") 'Change as required

Do While strF <> vbNullString

x = 2

Open strF For Input As #1 Do Until EOF(1)

    Line Input #1, textline
    text = text & textline
    tFlux = InStr(text, "tflux")

    Range("B" & x).Value = Mid(text, tFlux + 9, 3)
    x = x + 1
Loop

Close #1 text = "" strF = Dir() Loop
End Sub

Upvotes: 2

Related Questions