Results 1 to 8 of 8

Thread: Macro Running Slow (Loop)

  1. #1

    Thread Starter
    New Member
    Join Date
    Nov 2013
    Posts
    14

    Macro Running Slow (Loop)

    HI Everyone,

    I am currently using a macro to gather data from multiple files , it has allot of variable conditions and it needs to keep looping because sometimes the number of files can be upto 5000 or even more at the time.

    After a While of running the Macro it goes extremely slow like spending more than 10 mins per file which if I do manually would take me 1 min max, I have posed the Code below (its long) hopefully someone can assist me with this.

    Code:
    Sub Get_Data()
    '
    
    
      Dim stPath As String
      Dim stFile As String
      Dim stNewPath As String
      Dim StBN As String
      Dim StPN As String
      Dim StAd1 As String
      Dim StAd2 As String
      Dim StAd3 As String
      Dim StTB As String
      
      
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
      Sheets("Main").Activate
      Sheets("Data").Activate
      
        Cells.Select
        Selection.ClearContents
        
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "Buisness Name"
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "Phone Number"
        Range("C1").Select
        ActiveCell.FormulaR1C1 = "Address Line 1"
        Range("D1").Select
        ActiveCell.FormulaR1C1 = "Address Line 2"
        Range("E1").Select
        ActiveCell.FormulaR1C1 = "Address Line 3"
        Range("F1").Select
        ActiveCell.FormulaR1C1 = "Type of Buisness"
        
        Range("A2").Select
        ActiveCell.FormulaR1C1 = "temp"
        Range("B2").Select
        ActiveCell.FormulaR1C1 = "temp"
        Range("C2").Select
        ActiveCell.FormulaR1C1 = "temp"
        Range("D2").Select
        ActiveCell.FormulaR1C1 = "temp"
        Range("E2").Select
        ActiveCell.FormulaR1C1 = "temp"
        Range("F2").Select
        ActiveCell.FormulaR1C1 = "temp"
        
      stPath = Sheets("Main").Range("F22").Value
      stFile = Dir(stPath & "\*.htm*")   '
      Do Until stFile = ""
        Workbooks.Open stPath & "\" & stFile, ReadOnly:=True
    
        Windows(stFile).Activate
        Cells.Find(What:="Within 4 blocks", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Activate
        ActiveCell.Offset(1, 0).Select
        If IsEmpty(Selection.Value) Then
        ActiveCell.Offset(-1, 0).Select
        GoTo Label1
        Else
    On Error GoTo ErrHandler1:
        Cells.Find(What:="Paid", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Activate
        GoTo Label1:
        End If
    Label2:
    On Error GoTo 0
    On Error GoTo ErrHandler2:
    Cells.Find(What:="Validated", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Activate
        
    Label1:
    On Error GoTo 0
    Do
    ActiveCell.Offset(5, 0).Select
    If IsEmpty(Selection.Value) Then
    ActiveCell.Offset(2, 0).Select
    If IsEmpty(Selection.Value) Then
    ActiveCell.Offset(1, 0).Select
    If IsEmpty(Selection.Value) Then
    ActiveCell.Offset(1, 0).Select
    Else
    End If
    Else
    End If
    StBN = Selection.Value
    ActiveCell.Offset(1, 0).Select
        If IsEmpty(Selection.Value) Then
        ActiveCell.Offset(1, 0).Select
            If IsEmpty(Selection.Value) Then
            ActiveCell.Offset(15, 0).Select
            If IsEmpty(Selection.Value) Then
            StTB = "No Buissness Type"
            Else
            StTB = Selection.Value
            End If
            ActiveCell.Offset(2, 0).Select
            If Selection.Value Like "Opened*" Then
            ActiveCell.Offset(1, 0).Select
            ElseIf Selection.Value Like "$*" Then
            ActiveCell.Offset(1, 0).Select
            End If
            StAd1 = Selection.Value
            ActiveCell.Offset(1, 0).Select
                If Selection.Value Like "Phone*" Then
                StAd2 = "No Address Line 2"
                StAd3 = StAd1
                StAd1 = "No Address Line 1"
                StPN = Selection.Value
                Else
                StAd2 = Selection.Value
                ActiveCell.Offset(1, 0).Select
                    If Selection.Value Like "Phone*" Then
                    StAd3 = StAd2
                    StAd2 = "No Address Line2"
                    StPN = Selection.Value
                    Else
                    StAd3 = Selection.Value
                    ActiveCell.Offset(1, 0).Select
                    StPN = Selection.Value
                    End If
                End If
            Else
            StTB = "No Type of Buisness"
            If Selection.Value Like "Opened*" Then
            ActiveCell.Offset(1, 0).Select
            ElseIf Selection.Value Like "$*" Then
            ActiveCell.Offset(1, 0).Select
            End If
            StAd1 = Selection.Value
            ActiveCell.Offset(1, 0).Select
                If Selection.Value Like "Phone*" Then
                StAd3 = StAd1
                StAd2 = "No Address Line 2"
                StAd1 = "No Address Line 1"
                StPN = Selection.Value
                Else
                StAd2 = Selection.Value
                ActiveCell.Offset(1, 0).Select
                    If Selection.Value Like "Phone*" Then
                    StAd3 = StAd2
                    StAd2 = "No Address Line 2"
                    StPN = Selection.Value
                    Else
                    StAd3 = Selection.Value
                    ActiveCell.Offset(1, 0).Select
                    StPN = Selection.Value
                    End If
                End If
            End If
        Else
        StTB = Selection.Value
        ActiveCell.Offset(2, 0).Select
        If Selection.Value Like "Opened*" Then
        ActiveCell.Offset(1, 0).Select
        ElseIf Selection.Value Like "$*" Then
        ActiveCell.Offset(1, 0).Select
        End If
        StAd1 = Selection.Value
        ActiveCell.Offset(1, 0).Select
            If Selection.Value Like "Phone*" Then
            StAd2 = "No Address Line 2"
            StAd3 = StAd1
            StAd1 = "No Address Line1"
            StPN = Selection.Value
            Else
            StAd2 = Selection.Value
            ActiveCell.Offset(1, 0).Select
                    If Selection.Value Like "Phone*" Then
                    StAd3 = StAd2
                    StAd2 = "No Address Line 2"
                    StPN = Selection.Value
                    Else
                    StAd3 = Selection.Value
                    ActiveCell.Offset(1, 0).Select
                    StPN = Selection.Value
                    End If
            
            End If
         End If
    ElseIf IsNumeric(Selection.Value) Then
    Exit Do
    ElseIf Selection.Value Like "Page*" Then
    Exit Do
    Else
    StBN = Selection.Value
    ActiveCell.Offset(1, 0).Select
        If IsEmpty(Selection.Value) Then
        ActiveCell.Offset(1, 0).Select
            If IsEmpty(Selection.Value) Then
            ActiveCell.Offset(15, 0).Select
            If IsEmpty(Selection.Value) Then
            StTB = "No Buissness Type"
            Else
            StTB = Selection.Value
            End If
            ActiveCell.Offset(2, 0).Select
            If Selection.Value Like "Opened*" Then
            ActiveCell.Offset(1, 0).Select
            ElseIf Selection.Value Like "$*" Then
            ActiveCell.Offset(1, 0).Select
            End If
            StAd1 = Selection.Value
            ActiveCell.Offset(1, 0).Select
                If Selection.Value Like "Phone*" Then
                StAd2 = "No Address Line 2"
                StAd3 = StAd1
                StAd1 = "No Address Line1"
                StPN = Selection.Value
                Else
                StAd2 = Selection.Value
                ActiveCell.Offset(1, 0).Select
                    If Selection.Value Like "Phone*" Then
                    StAd3 = StAd2
                    StAd2 = "No Address Line 2"
                    StPN = Selection.Value
                    Else
                    StAd3 = Selection.Value
                    ActiveCell.Offset(1, 0).Select
                    StPN = Selection.Value
                    End If
                End If
            Else
            StTB = "No Type of Buisness"
            If Selection.Value Like "Opened*" Then
            ActiveCell.Offset(1, 0).Select
            ElseIf Selection.Value Like "$*" Then
            ActiveCell.Offset(1, 0).Select
            End If
            StAd1 = Selection.Value
            ActiveCell.Offset(1, 0).Select
                If Selection.Value Like "Phone*" Then
                StAd2 = "No Address Line 2"
                StAd3 = StAd1
                StAd1 = " No Address Line1"
                StPN = Selection.Value
                Else
                StAd2 = Selection.Value
                ActiveCell.Offset(1, 0).Select
                    If Selection.Value Like "Phone*" Then
                    StAd3 = StAd2
                    StAd2 = "No Address Line 2"
                    StPN = Selection.Value
                    Else
                    StAd3 = Selection.Value
                    ActiveCell.Offset(1, 0).Select
                    StPN = Selection.Value
                    End If
                End If
            End If
        Else
        StTB = Selection.Value
        ActiveCell.Offset(2, 0).Select
        If Selection.Value Like "Opened*" Then
        ActiveCell.Offset(1, 0).Select
        ElseIf Selection.Value Like "$*" Then
        ActiveCell.Offset(1, 0).Select
        End If
        StAd1 = Selection.Value
        ActiveCell.Offset(1, 0).Select
            If Selection.Value Like "Phone*" Then
            StAd2 = "No Address Line 2"
            StAd3 = StAd1
            StAd1 = "No Address Line 1"
            StPN = Selection.Value
            Else
            StAd2 = Selection.Value
            ActiveCell.Offset(1, 0).Select
                    If Selection.Value Like "Phone*" Then
                    StAd3 = StAd2
                    StAd2 = "No Address Line 2"
                    StPN = Selection.Value
                    Else
                    StAd3 = Selection.Value
                    ActiveCell.Offset(1, 0).Select
                    StPN = Selection.Value
                    End If
            End If
        End If
    End If
        Windows("Lead Extractor US (Yelp) V2.0.xlsb").Activate
        Range("A1").End(xlDown).Offset(1, 0).Select
        Selection.Value = StBN
        Range("B1").End(xlDown).Offset(1, 0).Select
        Selection.Value = StPN
        Range("C1").End(xlDown).Offset(1, 0).Select
        Selection.Value = StAd1
        Range("D1").End(xlDown).Offset(1, 0).Select
        Selection.Value = StAd2
        Range("E1").End(xlDown).Offset(1, 0).Select
        Selection.Value = StAd3
        Range("F1").End(xlDown).Offset(1, 0).Select
        Selection.Value = StTB
        Windows(stFile).Activate
    Loop
    Label3:
    On Error GoTo 0
    Windows(stFile).Activate
    ActiveWorkbook.Close False
    Windows("Lead Extractor US (Yelp) V2.0.xlsb").Activate
        stFile = Dir()
    Loop
    Range("A2:F2").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlUp
        
        Range("A1").Select
        Sheets("Main").Activate
        Range("F12").Select
        
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Exit Sub
    ErrHandler1:
    Resume Label2:
    
    ErrHandler2:
    Resume Label3:
    End Sub

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Macro Running Slow (Loop)

    change all reference to activecell to a fully qualified range. avoid selecting or activating anything
    exmple
    Sheets("Main").Activate
    Sheets("Data").Activate

    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Buisness Name"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Phone Number"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Address Line 1"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Address Line 2"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Address Line 3"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Type of Buisness"
    to
    Code:
    with sheets("Data")
        .usedrange.clearcontents
        .Range("A1").FormulaR1C1 = "Buisness Name"
        .Range("B1").FormulaR1C1 = "Phone Number"
        .Range("C1").FormulaR1C1 = "Address Line 1"
        .Range("D1").FormulaR1C1 = "Address Line 2"
        .Range("E1").FormulaR1C1 = "Address Line 3"
        .Range("F1").FormulaR1C1 = "Type of Buisness"
    end with
    as you are working with multiple sheets, it may be better to set worksheet objects to work with

    are all the files closing, before opening the next?
    keep a count in your error handlers to see how much they are called
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  3. #3

    Thread Starter
    New Member
    Join Date
    Nov 2013
    Posts
    14

    Re: Macro Running Slow (Loop)

    Quote Originally Posted by westconn1 View Post
    change all reference to activecell to a fully qualified range. avoid selecting or activating anything
    exmple

    to
    Code:
    with sheets("Data")
        .usedrange.clearcontents
        .Range("A1").FormulaR1C1 = "Buisness Name"
        .Range("B1").FormulaR1C1 = "Phone Number"
        .Range("C1").FormulaR1C1 = "Address Line 1"
        .Range("D1").FormulaR1C1 = "Address Line 2"
        .Range("E1").FormulaR1C1 = "Address Line 3"
        .Range("F1").FormulaR1C1 = "Type of Buisness"
    end with
    as you are working with multiple sheets, it may be better to set worksheet objects to work with

    are all the files closing, before opening the next?
    keep a count in your error handlers to see how much they are called
    The error Handlers rarley gets called, the files are bieng closed before opening the new ones and for activating cells unfortunetly i have to move allot to gather the data and there are allot of conditions so I have to keep moving using
    Code:
    activecell.offset(x,x).activate
    as for setting worksheet objects I am not sure what you mean

  4. #4
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: Macro Running Slow (Loop)

    You don't need to "move" to gather the data, which is part of what Pete is saying.

    A "Find" can return the range in which the text is found, rather than activating the cell. Once you know where the text is found, you can get value from a cell offset from that cell.

  5. #5

    Thread Starter
    New Member
    Join Date
    Nov 2013
    Posts
    14

    Re: Macro Running Slow (Loop)

    Quote Originally Posted by vbfbryce View Post
    You don't need to "move" to gather the data, which is part of what Pete is saying.

    A "Find" can return the range in which the text is found, rather than activating the cell. Once you know where the text is found, you can get value from a cell offset from that cell.
    I am sorry , I know im acting kinda Dumb ( havent slept properly for a while ) but I am not sure what you mean , can you write an example just for me to get a better Picture?

    because I keep going back to the same sheet get the data from it in strings and the place the value of the strings in another excel sheet, the issue is the data is not in a specific cell, its not constant thats why I have allot of if conditions

  6. #6
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: Macro Running Slow (Loop)

    No problem, will post a quick example in a few minutes

  7. #7
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: Macro Running Slow (Loop)

    A quick example of opening files, checking your conditions and grabbing data without activating and selecting:

    Code:
    Sub openFiles()
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim stPath As String
        Dim stFile As String
        Dim StBN As String
        Dim StPN As String
        Dim StAd1 As String
        Dim StAd2 As String
        Dim StAd3 As String
        Dim StTB As String
        Dim rngFind As Range    'the cell (range) where "Within 4 blocks" is found, ie.
        Dim rngCurrent As Range
        Dim rngNew As Range
        
        stPath = "c:\users\...\documents\vb\logan"  'change to yours
        stFile = Dir(stPath & "\*.htm*")
        Do Until stFile = ""
            Set wb = Workbooks.Open(stPath & "\" & stFile, ReadOnly:=True)
            Set ws = wb.Worksheets(1)   'not sure about this...
            
            Set rngFind = ws.Cells.Find(What:="Within 4 blocks", After:=ActiveCell, LookIn:=xlFormulas _
                , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
        
            If IsEmpty(rngFind.Offset(1, 0)) Then
                rngCurrent = rngFind.Offset(-1, 0)
            Else
                rngCurrent = rngFind.Offset(1, 0)
            End If
            GoTo label1
        Loop
        
    label1:
        With rngCurrent
            If Not IsEmpty(.Offset(5, 0)) Then
                StBN = .Offset(5, 0).Value
            ElseIf Not IsEmpty(.Offset(7, 0)) Then
                StBN = .Offset(7, 0).Value
            ElseIf Not IsEmpty(.Offset(8, 0)) Then
                StBN = .Offset(8, 0).Value
            ElseIf Not IsEmpty(.Offset(9, 0)) Then
                StBN = .Offset(9, 0).Value
            Else
                StBN = "NO VALUE?"
            End If
        End With
    End Sub

  8. #8
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Macro Running Slow (Loop)

    in most cases, the only good reason to activate a sheet or a cell, is to present it to the user at the end of the macro

    you can loop through all the cells you want and read their data, without selecting, just use a fully qualified range
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width