Search and copy data from text to Excel

[AjinkyaG]

Hi team,
I have one text file which contains data about list of errors.
I want to search only for ERROR word which have occurred multiple times in file and copy data quoted in '......' which is following the word ERROR=
Format is: ERROR = "short name of error.(number of words may vary,but the text following error is quoted in '...')" .
I tried this to open the file:-

Sub FileOpenDialogBox()
Dim myFile As String, text As String, textline As String, posLat As Integer, posLong As Integer
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Excel Files", " *.txt", 1
.Show
fullpath = .SelectedItems.Item(1)
End With
End Sub

And to search and copy data:-

Sub import()
Dim myFile As String, text As String, textline As String, posLat As Integer, posLong As Integer
myFile = "fullpath"
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
posLat = InStr(text, "ERROR")

Range("A1").Value = Mid(text, posLat + 10, 5)

End Sub

with this script i am not able to copy each error from that text file and also data between '......' is not captured.
Can you please help me with it.

 

[Yongle]

Try this

Sub AjinkyaG()
Const FindText = "ERROR  = "
Dim fData As String, fPath As String, matchText As String, r As Long, B As Range, C As Range

Set B = Range("B" & Rows.Count)
Set C = Range("C" & Rows.Count)
fPath = GetPath
If fPath = "" Then GoTo TheEnd

Open fPath For Input As #1
    Do Until EOF(1)
        Line Input #1, fData
        fData = Trim(fData)
        If Left(fData, 9) = FindText Then
            fData = Trim(Replace(Replace(fData, FindText, ""), "'", ""))
            matchText = Trim(Mid(fData, 11, 999))
            On Error Resume Next
            r = Range("B:B").Find(matchText, LookAt:=xlWhole, MatchCase:=False).Row
            If Err.Number <> 0 Then r = WorksheetFunction.Max(B.End(xlUp).Row, C.End(xlUp).Row) + 1
            On Error GoTo 0
            If WorksheetFunction.CountIf(Range("C:C"), fData) = 0 Then Range("C" & r) = fData
        End If
    Loop
Close #1
Exit Sub
TheEnd:
MsgBox "file not selected", , ""
End Sub

Private Function GetPath() As String
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Filters.Add "Text", "*.txt"
    .Show
    If .SelectedItems.Count = 1 Then GetPath = .SelectedItems.Item(1)
End With
End Function

Assumes that
- Column B is completed before the code is run
- Error text to match with column B is downloaded error text beginning at character 11
(ie VBA ignores "DEAL WITH " and matches the remaining string)
- duplicates are not repeated

Caveat
If everything appears "at the end", then "DEAL WITH " + string in column B does not match any cell in column C

 

[AjinkyaG]

Thanks for everything!!!!
But the problem is everything appears at the end.
I am sorry but I am not able to understand: "If everything appears "at the end", then "DEAL WITH " + string in column B does not match any cell in column C ".

 

[AjinkyaG]

Understood :
"If everything appears "at the end", then "DEAL WITH " + string in column B does not match any cell in column C ".

Sorry to inform but before ONE/TWO/THREE there is link of the file so the number of string is variable.
its in the form: "D/folder list/Sub list/DEAL WITH ONE".. in order to be short I deleted the data before "DEAL" in every case.

 

[Yongle]

before ONE/TWO/THREE there is link of the file so the number of string is variable.
its in the form: "D/folder list/Sub list/DEAL WITH ONE"

Try this, which finds the last "\" and tries to match the remaining string

Sub AjinkyaG()
Const FindText = "ERROR  = "
Dim fData As String, fPath As String, matchText As String, r As Long, B As Range, C As Range

Set B = Range("B" & Rows.Count)
Set C = Range("C" & Rows.Count)
fPath = GetPath
If fPath = "" Then GoTo TheEnd

Open fPath For Input As #1
    Do Until EOF(1)
        Line Input #1, fData
        fData = LTrim(fData)
        If Left(fData, 9) = FindText Then
            fData = LTrim(Replace(Replace(fData, FindText, ""), "'", ""))
            matchText = Right(fData, Len(fData) - InStrRev(fData, "\"))
            matchText = Right(matchText, Len(matchText) - 10)
            On Error Resume Next
                r = Range("B:B").Find(matchText, LookAt:=xlWhole, MatchCase:=False).Row
                If Err.Number <> 0 Then r = WorksheetFunction.Max(B.End(xlUp).Row, C.End(xlUp).Row) + 1
            On Error GoTo 0
            If WorksheetFunction.CountIf(Range("C:C"), fData) = 0 Then Range("C" & r) = fData
        End If
    Loop
Close #1
Exit Sub
TheEnd:
MsgBox "file not selected", , ""
End Sub

NOTE
I assumed that you made a mistake in "D/folder list/Sub list/DEAL WITH ONE" and that you meant to write "D\folder list\Sub list\DEAL WITH ONE"
Amend this line if necessary

 matchText = Right(fData, Len(fData) - InStrRev(fData, "/"))

 

[AjinkyaG]

Thanks Alot..thanks a tonn!!!!
Instead of taking the last string after "/" ,can we just search for one/two/three/ i.e data of 2nd column by taking them one after the other and find it in the C column..which would make code more flexible..

 

[Yongle]

yes Range.Find can do that if you prefer

what should happen if there is more than one line in the text file which contains "....../DEAL WITH ONE" ?
- the current code only lists the first match - is that what you want?

 

[AjinkyaG]

Thanks!!Appreciate your suggestions and Questions!!
Actually there are some cases where DEAL WITH ONE is repeated, sometimes in same line (as its link of folder) or after some intervals...
I wanted to search and copy found (output of search) line to respective position only once..once DEAL WITH ONE is found and moved,then even if its repeated it should go at the bottom.

 

[Yongle]

OK - busy now
- will post amended code within 24 hours

 

[AjinkyaG]

ok No problem

 

[AjinkyaG]

Hi,

yes Range.Find can do that if you prefer

Set matchText = Range("C1:C105").Find("fdata")


I am using this but its not processing anything.
How can we use Range.Find in this case.
Thanks for your Time!!