Macro run time exponentially increases when run several times in a row/in loop

J

j0nthn

New Member
Joined
Jan 7, 2016
Messages
25
When I try to run below code in a loop, or several times in a row (i.e. Call RunAllMergeSheets, Call RunAllMergeSheets etc) the time it takes to run the macro increases exponentially.
- Is there any way to speed this up? What's causing the biggest slowdown in the speed (minus the increase in file-size)

Many thanks for your help

Code: 
Sub RunAllMergeSheets()    
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'Set Dest to worksheet "ALL"
    Set DestSh = ActiveWorkbook.Worksheets("ALL")
    DestSh.Name = "ALL"


    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
        If IsError(Application.Match(sh.Name, _
    Array(DestSh.Name, "Setup instructions", "How to use", "DATA", "INPUT"), 0)) Then


            'Find the last row with data on the DestSh
            Last = LastRow(DestSh)


            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("E2:J5001")
            
            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If


            'This example copies values/formats, if you only want to copy the
            'values or want to copy everything look at the example below this macro
            With CopyRng
            DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
            .Columns.Count).Value = .Value
            End With


            'Optional: This will copy the sheet name + time stamps in the respective columns
            DestSh.Cells(Last + 1, "G").Resize(CopyRng.Rows.Count).Value = sh.Name
            DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Range("B5")
            DestSh.Cells(Last + 1, "I").Resize(CopyRng.Rows.Count).Value = sh.Range("B6")


        End If
    Next


ExitTheSub:


    Application.Goto DestSh.Cells(1)
    
    'Delete empty rows
    On Error Resume Next
    Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    'Add one to start + end dates
    Dim r As Range
    
    Sheets("INPUT").Select


    Set r = Range("B2:B3")


    For Each cell In r
        If IsDate(cell.Value) Then
            If cell.Value > 0 Then
                cell.Value = cell.Value + 1
            End If
        Else
            MsgBox "Cell " & cell.Address(0, 0) & "is not a date"
            Exit Sub
        End If
    Next


End Sub




Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
 
Sort by date Sort by votes
My macro is supposed to exclude the mentioned sheets ("Setup instructions","how to use") etc., whereas your Macro actually selects these macros I believe?

Also I think the issue with the copied line is that it tries to convert the array to a string, which doesn't seem to properly work - it says that 'var = Empty'

I don't think you need my data, but does it work for you if have above mentioned sheets and three extra sheets, let's say "Data1", "Data2" and Data3"?

The macro is supposed to compile all data from range E2:J5001 from sheets Data1, Data2 and Data3 in the 'All' Sheet (excl. above sheets), and then also append 2 extra rows of data taken from 2 cells in those three sheets

Below the code again with improved comments..

Code: 
Sub RunAllMergeSheets()    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Sheets("ID_B").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
            
        End Select
    
    Sheets("ID_NB").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
                
        End Select
        
     Sheets("MY_B").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
                
        End Select
        
    Sheets("MY_NB").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
                
        End Select
        
    Sheets("PH_B").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
                
        End Select
        
    Sheets("PH_NB").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
                
        End Select
        
    Sheets("TH_B").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
                
        End Select
        
     Sheets("TH_NB").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
                
        End Select
        
     Sheets("VN_B").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
                
        End Select
        
     Sheets("VN_NB").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
                
        End Select
        
     Sheets("SG_B").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
                
        End Select
        
     Sheets("SG_NB").Select
        Select Case ActiveWorkbook.ActiveSheet.Range("B8").Value
            Case "URLCrawlerErrors"
                Call GSC_Query_CrawlError.GSC_Query_CrawlError
            Case "SearchAnalytics:Query"
                Call GSC_Query.GSC_Query
                
        End Select
        
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'Set Dest to worksheet "SEA"
    Set DestSh = ActiveWorkbook.Worksheets("SEA")
    DestSh.Name = "SEA"


    'loop through all worksheets EXCEPT BELOW SHEETS and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
        If IsError(Application.Match(sh.Name, _
    Array(DestSh.Name, "Setup instructions", "How to use", "DATA", "INPUT"), 0)) Then


            'Find the last row with data on the DestSh
            Last = LastRow(DestSh)


            'Fill in the range that you want to copy from all sheets
            Set CopyRng = sh.Range("E2:J5001")
            
            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If


            'Copy Paste value only (no clipboard)
            With CopyRng
            DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
            .Columns.Count).Value = .Value
            End With


            'This will copy the sheet name + time stamps (taken from cell B5 + B6) in the respective columns
            DestSh.Cells(Last + 1, "G").Resize(CopyRng.Rows.Count).Value = sh.Name
            DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Range("B5")
            DestSh.Cells(Last + 1, "I").Resize(CopyRng.Rows.Count).Value = sh.Range("B6")


        End If
    Next


ExitTheSub:


    Application.Goto DestSh.Cells(1)
    
    'Delete empty rows in the DestSh
    On Error Resume Next
    Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    'Add one to start + end dates
    Dim r As Range
    
    Sheets("INPUT").Select


    Set r = Range("B2:B3")


    For Each cell In r
        If IsDate(cell.Value) Then
            If cell.Value > 0 Then
                cell.Value = cell.Value + 1
            End If
        Else
            MsgBox "Cell " & cell.Address(0, 0) & "is not a date"
            Exit Sub
        End If
    Next


End Sub




Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Revised, without the first part of the code:

Sub RunAllMergeSheets()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range


With Application
.ScreenUpdating = False
.EnableEvents = False
End With


'Set Dest to worksheet "SEA"
Set DestSh = ActiveWorkbook.Worksheets("SEA")
DestSh.Name = "SEA"


'loop through all worksheets EXCEPT BELOW SHEETS and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(sh.Name, _
Array(DestSh.Name, "Setup instructions", "How to use", "DATA", "INPUT"), 0)) Then


'Find the last row with data on the DestSh
Last = LastRow(DestSh)


'Fill in the range that you want to copy from all sheets
Set CopyRng = sh.Range("E2:J5001")

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If


'Copy Paste value only (no clipboard)
With CopyRng
DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
.Columns.Count).Value = .Value
End With


'This will copy the sheet name + time stamps (taken from cell B5 + B6) in the respective columns
DestSh.Cells(Last + 1, "G").Resize(CopyRng.Rows.Count).Value = sh.Name
DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Range("B5")
DestSh.Cells(Last + 1, "I").Resize(CopyRng.Rows.Count).Value = sh.Range("B6")


End If
Next


ExitTheSub:


Application.Goto DestSh.Cells(1)

'Delete empty rows in the DestSh
On Error Resume Next
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'Add one to start + end dates
Dim r As Range

Sheets("INPUT").Select


Set r = Range("B2:B3")


For Each cell In r
If IsDate(cell.Value) Then
If cell.Value > 0 Then
cell.Value = cell.Value + 1
End If
Else
MsgBox "Cell " & cell.Address(0, 0) & "is not a date"
Exit Sub
End If
Next


End Sub




Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
 
Upvote 0
Misread how you were choosing sheets to include/exclude, yes my code was selecting the ones you didn't want selected. I'm just changing the part in the original post, all that case select stuff in the first part of the (updated) code, I won't re-do. Try:
Code: 
Sub MergeSheets()

    Dim wks     As Worksheet
    Dim wksDest As Worksheet
    
    Dim var     As Variant
    Dim arr()   As Variant
    
    Dim rng     As Range
    
    Dim LR      As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set wksDest = Sheets("All")
    shtNames = Array("Setup instructions", "How to use", "DATA", "Input")
    
    For Each wks In ThisWorkbook.Worksheets
    
        Select Case wks.Name
            'Ignore sheets with these names
            Case "Setup instructions", "How to use", "DATA", "Input"
                
            Case Else
            
                arr = wks.Range("E2:J5001").value
                With wksDest
                    LR = .Cells(.rows.count, 1).End(xlUp).row
                    If LR + UBound(arr, 1) <= wksDest.rows.count Then
                        With .Cells(LR + 1, 1)
                            .Resize(UBound(arr, 1), UBound(arr, 2)).value = arr
                            Erase arr
                            .Offset(, 6).value = wks.Name
                            .Offset(, 7).Resize(, 2).value = wks.Range("B5:B6").value
                        End With
                    Else
                        Erase arr
                        MsgBox "Not enough rows in " & wksDest.Name & " sheet to merge further data", vbOKOnly, "Excess number of rows required"
                        Exit For
                    End If
                End With
                
        End Select
    
    Next wks
    
    On Error Resume Next
    wksDest.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    With Sheets("INPUT")
        For Each rng In .Range("B2:B3")
            If IsDate(rng.value) Then
                rng.value = rng.value = 1
            Else
                MsgBox "Cell " & rng.Address(0, 0) & " is not a date", vbExclamation, "Cell not a date"
            End If
        
        Next rng
        .Select
    End With
    
    
    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    End With
    
    Set wksDest = Nothing
  
End Sub
 
Last edited:
Upvote 0
Redundant line of code in the above, which may cause an error, try following instead:
Code: 
Sub MergeSheets()

    Dim wks     As Worksheet
    Dim wksDest As Worksheet
    
    Dim var     As Variant
    Dim arr()   As Variant
    
    Dim rng     As Range
    
    Dim LR      As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set wksDest = Sheets("All")
    
    For Each wks In ThisWorkbook.Worksheets
    
        Select Case wks.Name
            'Ignore sheets with these names
            Case "Setup instructions", "How to use", "DATA", "Input"
                
            Case Else
            
                arr = wks.Range("E2:J5001").value
                With wksDest
                    LR = .Cells(.rows.count, 1).End(xlUp).row
                    If LR + UBound(arr, 1) <= wksDest.rows.count Then
                        With .Cells(LR + 1, 1)
                            .Resize(UBound(arr, 1), UBound(arr, 2)).value = arr
                            Erase arr
                            .Offset(, 6).value = wks.Name
                            .Offset(, 7).Resize(, 2).value = wks.Range("B5:B6").value
                        End With
                    Else
                        Erase arr
                        MsgBox "Not enough rows in " & wksDest.Name & " sheet to merge further data", vbOKOnly, "Excess number of rows required"
                        Exit For
                    End If
                End With
                
        End Select
    
    Next wks
    
    On Error Resume Next
    wksDest.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    With Sheets("INPUT")
        For Each rng In .Range("B2:B3")
            If IsDate(rng.value) Then
                rng.value = rng.value = 1
            Else
                MsgBox "Cell " & rng.Address(0, 0) & " is not a date", vbExclamation, "Cell not a date"
            End If
        
        Next rng
        .Select
    End With
     
    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    End With
    
    Set wksDest = Nothing
  
End Sub
 
Upvote 0
Hi Jack, thanks again for the input, it's super fast, two things not working properly yet:

1) This part of your code doesn't properly add the worksheet name + cell values in the three columns behind the merged data -- it does only does so correctly for the first row, the other rows are blank

Code: 
[COLOR=#333333]                            Erase arr[/COLOR]                            .Offset(, 6).value = wks.Name
                            .Offset(, 7).Resize(, 2).value = wks.Range("B5:B6").value [COLOR=#333333]                        End With[/COLOR]


2) Less important as I can just use the part of my code, but this part of your code doesn't properly add 1 day to the dates in these two cells:

Code: 
[COLOR=#333333]    With Sheets("INPUT")[/COLOR]        For Each rng In .Range("B2:B3")
            If IsDate(rng.value) Then
                rng.value = rng.value = 1
            Else
                MsgBox "Cell " & rng.Address(0, 0) & " is not a date", vbExclamation, "Cell not a date"
            End If
        
        Next rng
        .Select [COLOR=#333333]    End With[/COLOR]
 
Upvote 0
Try:
Code: 
Sub MergeSheets()


    Dim wks     As Worksheet
    Dim wksDest As Worksheet
    
    Dim var     As Variant
    Dim arr()   As Variant
    
    Dim rng     As Range
    
    Dim LR      As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set wksDest = Sheets("All")
    
    For Each wks In ThisWorkbook.Worksheets
    
        Select Case wks.Name
            'Ignore sheets with these names
            Case "Setup instructions", "How to use", "DATA", "Input"
                
            Case Else
            
                arr = wks.Range("E2:J5001").Value
                With wksDest
                    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
                    If LR + UBound(arr, 1) <= wksDest.Rows.Count Then
                        With .Cells(LR + 1, 1)
                            .Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
                            Erase arr
                            .Offset(, 6).Value = wks.Name
                            .Offset(, 7).wks.Range("B5").Value
                            .Offset(, 8).wks.Range("B6").Value
                        End With
                    Else
                        Erase arr
                        MsgBox "Not enough rows in " & wksDest.Name & " sheet to merge further data", vbOKOnly, "Excess number of rows required"
                        Exit For
                    End If
                End With
                
        End Select
    
    Next wks
    
    On Error Resume Next
    wksDest.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    With Sheets("INPUT")
        For Each rng In .Range("B2:B3")
            If IsDate(rng.Value) Then
                rng.Value = DateAdd("dd", 1, rng.Value)
            Else
                MsgBox "Cell " & rng.Address(0, 0) & " is not a date", vbExclamation, "Cell not a date"
            End If
        
        Next rng
        .Select
    End With
     
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    Set wksDest = Nothing
  
End Sub
 
Last edited:
Upvote 0
Run-time error (438: Object doesn't support this property or method) for this line:

Code: 
.Offset(, 7).wks.Range("B5").Value
 
Upvote 0
Typo, change:
Code: 
.Offset(, 7).wks.Range("B5").Value
.Offset(, 8).wks.Range("B6").Value
to
Code: 
.Offset(, 7).value = wks.Range("B5").Value
.Offset(, 8).value = wks.Range("B6").Value
 
Upvote 0
Thanks, the code is running again, but it still only adds the name of the worksheets (and the timestamps) to only the first row of each copied range, whereas I want it to be on every row, i.e.:

NOW:

Col 1 || Col 2 || Col 3 || Col 4
xx || xx || Name1 || stamp1
xx || xx || [blank] || [blank]
...
xx || xx || Name2 || stamp2


DESIRED:

Col 1 || Col 2 || Col 3 || Col 4
xx || xx || Name1 || stamp1
xx || xx || Name1 || stamp1
xx || xx || Name1 || stamp1
...
xx || xx || Name2 || stamp2
 
Upvote 0
OK, try:
Code: 
Sub MergeSheets()

    Dim wks     As Worksheet
    Dim wksDest As Worksheet
    
    Dim var     As Variant
    Dim arr()   As Variant
    
    Dim rng     As Range
    
    Dim LR      As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set wksDest = Sheets("All")
    
    For Each wks In ThisWorkbook.Worksheets
    
        Select Case wks.Name
            'Ignore sheets with these names
            Case "Setup instructions", "How to use", "DATA", "Input"
                
            Case Else
            
                arr = wks.Range("E2:J5001").Value
                With wksDest
                    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
                    If LR + UBound(arr, 1) <= wksDest.Rows.Count Then
                        With .Cells(LR + 1, 1)
                            .Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
                            Erase arr
                            .Offset(, 6).Resize(UBound(arr, 1)).Value = wks.Name
                            .Offset(, 7).Resize(UBound(arr, 1)).wks.Range("B5").Value
                            .Offset(, 8).Resize(UBound(arr, 1)).wks.Range("B6").Value
                        End With
                    Else
                        Erase arr
                        MsgBox "Not enough rows in " & wksDest.Name & " sheet to merge further data", vbOKOnly, "Excess number of rows required"
                        Exit For
                    End If
                End With
                
        End Select
    
    Next wks
    
    On Error Resume Next
    wksDest.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    With Sheets("INPUT")
        For Each rng In .Range("B2:B3")
            If IsDate(rng.Value) Then
                rng.Value = DateAdd("dd", 1, rng.Value)
            Else
                MsgBox "Cell " & rng.Address(0, 0) & " is not a date", vbExclamation, "Cell not a date"
            End If
        
        Next rng
        .Select
    End With
     
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    Set wksDest = Nothing
  
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Speeding up VBA
Replies
9
Views
122
jvoss
J
P
  • Question Question
Consolodate data to matching columns
Replies
0
Views
399
PippaThePointer
P
A
  • Question Question
Automatically Merge data from a specific range from multiple sheets(avoid blank cells)
Replies
0
Views
683
andybc33
A
T
  • Question Question
VBA to run when a table with a SQL query is refreshed?
Replies
0
Views
170
Tarver
T
G
  • Solved
If Else Loop macro running slow, anyway to speed it up?
Replies
9
Views
264
Alex Blakenburg
A

Forum statistics

Threads
1,223,628
Messages
6,173,426
Members
452,515
Latest member
Alicedonald9

Share this page

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