print out previous line

newbie453

New Member
Joined
Nov 15, 2018
Messages
1
is there any way i can do to extract the previous sentence or the line above the searched word? i am trying to extract it from multiple text file. so far i managed to only get the searched term to pop up but not the above sentence. i am kinda new in vba so i did pick a few things from others who have codes that solved my problems. now is only this sentence issue. any help would be appreciated.
Code:
    Public errors As Integer
    Public X As Variant
    Public Y As Variant
    Public Sub testing()
    Dim fldr As FileDialog
    Dim sItem As String


    Dim z As Variant
    Dim ID As String
    Dim reminder As String
    Dim confirmation As String
    z = Now()
    start:


    If UserForm1.CommandButton1 = True Then
    Set X = CommandButton1.Name
    End If




       
       Y = Application.InputBox("Please enter your Employee ID", "For Verification Purposes", Type:=1)
       Select Case Y
       Case Y = ""
       Exit Sub
       End Select
       ID = MsgBox("Is your Employee ID, " & (Y) & ", correct?", vbYesNo, "Confirm?")
       Select Case ID
       Case vbYes
       GoTo foldersetting
       Case vbNo
       GoTo start
       End Select


            
     


    foldersetting:
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
    .Title = "Select a Folder for " & (X)
    .AllowMultiSelect = True
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
    End With


    NextCode:
    getfolder = sItem
    Set fldr = Nothing


    If getfolder = "" Then Exit Sub


    Dim fso As Object
    Dim fld As Object
    Dim strSearch, strsearch1 As String
    Dim strFile As String
    Dim wOut As Worksheet
    Dim wbk As Workbook
    Dim wks As Worksheet
    Dim lRow As Long
    Dim rFound As Range
    Dim strFirstAddress As String


    ' On Error GoTo ErrHandler
    Application.ScreenUpdating = False


        
        
    'Change as desired
    strPath = sItem             '////////////////   <--- Change directory here  \\\\\\\\\\\\\\\\\\\\\\\\
    strSearch = "Result: FAIL" '/////////////////    <--- Change term to search for here     \\\\\\\\\\\\\\\\\\\\\\\
    Set wOut = Worksheets.Add


        Application.StatusBar = True


        Application.StatusBar = "Please Wait..."
        
    lRow = 1
    With wOut
        .Cells(lRow, 1) = "Type: " & (X)
        .Cells(lRow, 2) = "Employee ID: " & (Y)
        .Cells(lRow, 3) = "Date & Time of Extract: " & (z)
        .Cells(lRow, 4) = ""                        'Reserved for future use.
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fld = fso.getfolder(strPath)








        strFile = Dir(strPath & "\*.txt")  '<-- Currently searching all Log files. Change extension here
        Do While strFile <> ""
            Set wbk = Workbooks.Open _
              (Filename:=strPath & "\" & strFile, _
              UpdateLinks:=0, _
              ReadOnly:=True, _
              AddToMRU:=False)




            For Each wks In wbk.Worksheets
                Set rFound = wks.UsedRange.Find(strSearch)
                If Not rFound Is Nothing Then
                    strFirstAddress = rFound.Address
                End If
                Do
                    If rFound Is Nothing Then
                        Exit Do
                    Else
                        lRow = lRow + 1
                        .Cells(lRow, 1) = rFound.Value
                      
                        .Cells(lRow, 2) = wbk.Name
                          
                    
                    End If
                    Set rFound = wks.Cells.FindNext(after:=rFound)


                Loop While strFirstAddress <> rFound.Address
            Next
            


            wbk.Close (False)
            strFile = Dir
    


        Loop
        .Columns("A:D").EntireColumn.AutoFit
        
     
    End With
    errors = (ActiveSheet.UsedRange.Rows.Count - 1)




    If (ActiveSheet.UsedRange.Rows.Count - 1) > 0 Then
    MsgBox "There are " & (ActiveSheet.UsedRange.Rows.Count - 1) & " Failures Found!", vbCritical, "Warning"
    ElseIf (ActiveSheet.UsedRange.Rows.Count - 1) = 0 Then
    MsgBox "No errors found.", vbInformation, "No Errors"
    Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In Worksheets
    Select Case sh.CodeName
    Case "Sheet1", "Sheet2"
    Case Else
    sh.Delete
    End Select
    Next sh
    Application.DisplayAlerts = True
    End If
    
    Dim lastrow As Long
    lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 2


    ActiveSheet.Cells(lastrow, "A").Value = "Number of Failures: " & 
    (ActiveSheet.UsedRange.Rows.Count - 1)
    On Error GoTo calling
    Dim rngData As Range
    Dim strData As String
    Dim strTempFile As String


    ' copy some range values
    Set rngData = wOut.Range("A:D")
    rngData.Copy


    ' get the clipboard data
    ' magic code for is for early binding to MSForms.DataObject
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        strData = .GetText
    End With


    ' write to temp file
    strTempFile = "D:\temp.txt"
    With CreateObject("Scripting.FileSystemObject")
        ' true to overwrite existing temp file
        .CreateTextFile(strTempFile, True).Write strData
    End With


    ' open notepad with tempfile
    Shell "cmd /c ""notepad.exe """ & strTempFile & """", vbHide
    calling:
    Call log
    
    ExitHandler:
    Set wOut = Nothing
    Set wks = Nothing
    Set wbk = Nothing
    Set fld = Nothing
    Set fso = Nothing
    Application.ScreenUpdating = True
    
    Application.DisplayAlerts = False
    For Each sh In Worksheets
    Select Case sh.CodeName
    Case "Sheet1", "Sheet2"
    Case Else
    sh.Delete
    End Select
    Next sh
    Application.DisplayAlerts = True
    Application.StatusBar = False


    End Sub
eg: ( this exmaple comes from the actual text file. there are a lot of these files in a folder hence i chose to use folders to search)


Running Script Line 2960: DELAY 2000


Running Script Line 2961: AIC 6 3.71 3.87 {LDC}


Result: FAIL 3.546


Running Script Line 2963: LDCCONSOLE w "dacout(0x62E6)\r\n"


Result: OK


Running Script Line 2964: DELAY 2000


Running Script Line 2965: AIC 6 4.2 4.36 {LDC}


Result: FAIL 4.000


Running Script Line 2967: LDCCONSOLE w "dacout(0x6E24)\r\n"


Result: OK


Running Script Line 2968: DELAY 2000


Running Script Line 2969: AIC 6 4.67 4.83 {LDC}


Result: FAIL 4.454


Running Script Line 2971: LDCCONSOLE w "dacout(0x796A)\r\n"


Result: OK


Running Script Line 2972: DELAY 2000


Running Script Line 2973: AIC 6 5.15 5.31 {LDC}


Result: FAIL 4.901


Running Script Line 2975: LDCCONSOLE w "dacout(0x84B5)\r\n"


Result: OK


Running Script Line 2976: DELAY 2000


Running Script Line 2977: AIC 6 5.62 5.78 {LDC}


Result: FAIL 5.348


Running Script Line 2979: LDCCONSOLE w "dacout(0x9005)\r\n"


Result: OK


Running Script Line 2980: DELAY 2000


Running Script Line 2981: AIC 6 6.1 6.26 {LDC}


Result: FAIL 5.792


Running Script Line 2983: LDCCONSOLE w "dacout(0x9B5B)\r\n"


Result: OK


Running Script Line 2984: DELAY 2000


Running Script Line 2985: AIC 6 6.57 6.73 {LDC}


Result: FAIL 6.235


Running Script Line 2987: LDCCONSOLE w "dacout(0xA6B5)\r\n"


Result: OK


Running Script Line 2988: DELAY 2000


Running Script Line 2989: AIC 6 7.05 7.21 {LDC}


Result: FAIL 6.681


Running Script Line 2991: LDCCONSOLE w "dacout(0xB215)\r\n"


Result: OK


Running Script Line 2992: DELAY 2000


Running Script Line 2993: AIC 6 7.54 7.7 {LDC}


Result: FAIL 7.126


Running Script Line 2995: LDCCONSOLE w "dacout(0xBD7A)\r\n"


Result: OK


Running Script Line 2996: DELAY 2000


Running Script Line 2997: AIC 6 8.02 8.18 {LDC}


Result: FAIL 7.572


in this example, the searched term will be "result: FAIL" and what i hope vba will print out will be the searched term plus the previous line for each searched term. i have already managed to do the searched term part. so for those which results are ok will be ignored. for those that failed, like the last script line, it will be printed out as:


Running Script Line 2997: AIC 6 8.02 8.18 {LDC}


Result: FAIL 7.572
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top