Tag: Shorten

My code here goes through my file and my files inside the folder and uses.find and copy the strings into a new Excel sheet and then with all the data from the new sheet I'm going to use .Find(What:=) to find the strings inside the new worksheet, then split or use the functions Right, Left, Medium, sometimes using replace, however 68 files require 1 minute 30 seconds of execution using this code and I need help to make it a more efficient and faster coding system, please advise me on this! even better if you can provide a little code!

Option Explicit

Sub GenerateData()

    Application.ScreenUpdating = False

    Dim wks As Worksheet
    Dim wkb As Workbook
    Set wkb = ActiveWorkbook
    Set wks = wkb.Worksheets.Add(After:=wkb.Worksheets(wkb.Worksheets.Count), Type:=xlWorksheet)

    ' Add headers data
    With wks
        .Range("A1:K1") = Array("Test", "Temp", "Type", "Start", "FileName", "No", "End", _
        "Month", "Smart", "Errors", "ErrorCellAddress")
    End With

    ' Early Binding - Add "Microsoft Scripting Runtime" Reference
        Dim FSO As New Scripting.FileSystemObject
    ' Set FolderPath
        Dim FolderPath As String
            FolderPath = "c:UsersDesktopTryout"
    ' Set Folder FSO
        Dim Folder As Scripting.Folder
            Set Folder = FSO.GetFolder(FolderPath)

    ' Loop thru each file
        Dim File As Scripting.File
        Dim a As Range, b As Range, c As Range, d As Range, e As Range, f As Range, g As Range, h As Range, l As Range
            For Each File In Folder.Files

            Dim wkbData As Workbook
                Set wkbData = Workbooks.Open(File.Path)

            Dim wksData As Worksheet
                ActiveSheet.Name = "Control"
                Set wksData = wkbData.Worksheets("Control") ' -> Assume this file has only 1 worksheet

        'Format of the data
            Dim BlankRow As Long
                BlankRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row + 1

        ' Write filename in col E,F,G
            wks.Cells(BlankRow, 5).Value = File.Name
            wks.Cells(BlankRow, 6).Value = File.Name
            wks.Cells(BlankRow, 7).Value = File.Name

        'Find Testtest
            Set a = wksData.Columns("A:A").Find("  testtest         : ", LookIn:=xlValues)
        If Not a Is Nothing Then
            wks.Cells(BlankRow, 1).Value = a.Value
        End If

        'Find Temp
            Set b = wksData.Columns("A:A").Find("  testflyy         : ", LookIn:=xlValues)
        If Not b Is Nothing Then
            wks.Cells(BlankRow, 2).Value = b.Value
        End If

        'Find Type
            Set d = wksData.Columns("A:A").Find("  testflyy         : ", LookIn:=xlValues)
        If Not d Is Nothing Then
            wks.Cells(BlankRow, 3).Value = d.Value
        End If

        'Find start
            Set l = wksData.Columns("A:A").Find("  Started at: ", LookIn:=xlValues)
        If Not l Is Nothing Then
            wks.Cells(BlankRow, 4).Value = l.Value
        End If

        'Find Smart
            Set c = wksData.Columns("A:A").Find("SmartABC ", LookIn:=xlValues)
        If Not c Is Nothing Then
            wks.Cells(BlankRow, 9).Value = c.Value
        Else
            Set f = wksData.Columns("A:A").Find("SmarABCD Version ", LookIn:=xlValues)
        If Not f Is Nothing Then
            wks.Cells(BlankRow, 9).Value = f.Value
        Else
            Set g = wksData.Columns("A:A").Find("smarabcd_efg revision", LookIn:=xlValues)
        If Not g Is Nothing Then
            wks.Cells(BlankRow, 9).Value = g.Value
        End If
        End If
        End If

        'Find Errors
            Set e = wksData.Columns("A:A").Find("ERROR: ABC", LookIn:=xlValues)
        If Not e Is Nothing Then
            wks.Cells(BlankRow, 10).Value = e.Value
            wks.Cells(BlankRow, 11).Value = e.Address
        Else
            Set h = wksData.Columns("A:A").Find("ERROR: EFG", LookIn:=xlValues)
        If Not h Is Nothing Then
            wks.Cells(BlankRow, 10).Value = h.Value
        End If
        End If


        ' Trim and tidy up Data

    'Trim Testtest RowA(1)
    wks.Cells(BlankRow, 1).Replace What:="testtest         : ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    'Trim StartTime RowD(4)
    wks.Cells(BlankRow, 4).Replace What:="  Started at: ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    'Trim Temp RowB(2)
        Dim strSearchB As String, strSearchC As String
        Dim bCell As Range, cCell As Range
        Dim s2 As String, s3 As String
            strSearchB = "  testflow         : B"
            strSearchC = "  testflow         : M"

    Set bCell = wks.Cells(BlankRow, 2).Find(What:=strSearchB, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

    If Not bCell Is Nothing Then
        s2 = Split(bCell.Value, ":")(1)
        s2 = Mid(s2, 1, 3)
        bCell.Value = s2
    Else

    Set cCell = wks.Cells(BlankRow, 2).Find(What:=strSearchC, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

    If Not cCell Is Nothing Then
        s3 = Split(cCell.Value, ":")(1)
        s3 = Mid(s3, 10, 2)
        cCell.Value = s3
    End If
    End If

    'Trim Type RowC(3)
        Dim strSearchD As String, strSearchE As String
        Dim dCell As Range, eCell As Range
        Dim s4 As String, s5 As String
            strSearchD = "  testflow         : B"
            strSearchE = "  testflow         : M1947"

    Set dCell = wks.Cells(BlankRow, 3).Find(What:=strSearchD, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

    If Not dCell Is Nothing Then
        s4 = Split(dCell.Value, "_", 3)(2)
        s4 = Mid(s4, 1, 3)
        dCell.Value = s4
    Else

    Set eCell = wks.Cells(BlankRow, 3).Find(What:=strSearchE, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

    If Not eCell Is Nothing Then
        eCell.Value = "123"
    End If
    End If

    'Trim No RowF(6)
        Dim strSearchF As String
        Dim fCell As Range
        Dim s6 As String
            strSearchF = "homebeestrash_archivetreser"

    Set fCell = wks.Cells(BlankRow, 6).Find(What:=strSearchF, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

    If Not fCell Is Nothing Then
        s6 = Split(fCell.Value, "treser")(1)
        s6 = Mid(s6, 1, 2)
        fCell.Value = s6
    End If

    'Trim EndDate RowG(7)
        Dim strSearchG As String
        Dim gCell As Range
        Dim s7 As String
            strSearchG = "homebeestrash_archivetreser"

    Set gCell = wks.Cells(BlankRow, 7).Find(What:=strSearchG, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

    If Not gCell Is Nothing Then
        s7 = Split(gCell.Value, "reports")(1) 
        s7 = Split(s7, "Report")(0) 
        s7 = Left(s7, 8) & " " & Right(s7, 6) 
        'Month Row H(8)
        wks.Cells(BlankRow, 8).Value = WorksheetFunction.Transpose(Left(s7, 4) & "-" & Mid(s7, 5, 2) & "-" & Mid(s7, 7, 2)) 
        gCell.Value = s7
    End If
        wks.Cells(BlankRow, 8).NumberFormat = "($-en-US)mmmm d, yyyy;@" 'Set Date format

    'Trim Smart
        Dim strSearchST As String
        Dim stCell As Range
        Dim s8 As String
            strSearchST = "This is "

    Set stCell = wks.Cells(BlankRow, 9).Find(What:=strSearchST, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

    If Not stCell Is Nothing Then
        s8 = Split(stCell.Value, "This is ")(1)
        s8 = Mid(s8, 1, 29)
        stCell.Value = s8
    End If

    wkbData.Close False
    Next File

    'Add AutoFilter
    Dim StartDate As Long, EndDate As Long

    With wks.Cells(BlankRow, 8)
        StartDate = DateSerial(Year(.Value), Month(.Value), 1)
        EndDate = DateSerial(Year(.Value), Month(.Value) + 1, 0)
    End With

    wks.Cells(BlankRow, 8).AutoFilter Field:=5, Criteria1:=">=" & StartDate, Operator:=xlAnd, Criteria2:="<=" & EndDate
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

End Sub
```