VBA Loop Gives Double Lines of Errors

O

OilEconomist

Active Member
Joined
Dec 26, 2016
Messages
439
Office Version
  1. 2019
Platform
  1. Windows
Thanks in advance for any suggestions for which feedback will be given.

This code runs through a series of tabs and wherever it sees an error, it takes that line and places it in the "Error.Items" sheet. Why is it duplicating each error? I guess I could write code at the end to remove the duplicate lines, but I would like to figure out what I am doing wrong. Also, some of the code I don't think I need so feel free to suggest. For example, is the following needed?

Code: 
If J = 1 Or J = 2 Or J = 6 Or J = 7 _
                        Or J = 8 Or J = 9 Or J = 10 Or J = 11 Or J = 12 _
                        Or J = 9 Or J = 10 Or J = 11 Or J = 12 Or J = 14 _
                        Or J = 15 Or J = 17 Or J = 19 Or J = 20 Or J = 21 _
                        Or J = 22 Or J = 23 Or J = 24 Or J = 27 _
                        Or J = 30 Or J = 31 Or J = 32 Or J = 33 Or J = 34 _
                        Or J = 35 Or J = 36 Or J = 37 Or J = 38 Or J = 39 _
                        Or J = 40 Then
                            'do nothing



The following is the entire code:

Code: 
Sub Error_Check()


'Turn off alerts, screen updates, and automatic calculation
        'Turn off Display Alerts
            Application.DisplayAlerts = False


        'Turn off Screen Update
            Application.ScreenUpdating = False


        'Turn off Automatic Calculations
            Application.Calculation = xlManual




'Dimensioning
    Dim LastRow As Long
    Dim Error_Row As Long
    Dim Error_Count As Long
    Dim Error_Count_Clm As Long
    Dim i As Long, J As Long, k As Long
    
    Dim X As Long




'Looping through all the tabs to find the errors
    Error_Row = 3
    
    For Each Sheet In ActiveWorkbook.Worksheets
        If Sheet.Name = "Error.Items" Or Sheet.Name = "JIBs.End" Then
            For X = Sheets("JIBs.End").Index - 1 To Sheets("Error.Items").Index + 1 Step -1


        'Find the last row of data
            Sheets(X).Activate
            
            LastRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
                    LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, MatchCase:=False).Row
            
            Error_Count = 0




            For i = 3 To LastRow
        
                Error_Count = 0
        
                For J = 1 To 41


                    If J = 1 Or J = 2 Or J = 6 Or J = 7 _
                        Or J = 8 Or J = 9 Or J = 10 Or J = 11 Or J = 12 _
                        Or J = 9 Or J = 10 Or J = 11 Or J = 12 Or J = 14 _
                        Or J = 15 Or J = 17 Or J = 19 Or J = 20 Or J = 21 _
                        Or J = 22 Or J = 23 Or J = 24 Or J = 27 _
                        Or J = 30 Or J = 31 Or J = 32 Or J = 33 Or J = 34 _
                        Or J = 35 Or J = 36 Or J = 37 Or J = 38 Or J = 39 _
                        Or J = 40 Then
                            'do nothing


                        ElseIf Cells(i, J) = "" And J = 3 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
            
                        ElseIf Cells(i, J) = "No CC Xref" And J = 5 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
            
                        ElseIf J = 5 Then
                            If Cells(i, J) = "" Or Cells(i, J) = "No CC Xref" Then
                                Cells(i, J).Font.Bold = True
                                Cells(i, J).Interior.ColorIndex = 3
                            End If
            
                        ElseIf J = 13 Then
                            If Cells(i, J) <> 1 And Cells(i, J) <> 3 Then
                                Cells(i, J).Font.Bold = True
                                Cells(i, J).Interior.ColorIndex = 3
                            End If
            
                        ElseIf Cells(i, J) = "" And J = 16 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
                
                        ElseIf Cells(i, J) = "" And J = 18 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
            
                        ElseIf Cells(i, J) = "" And J = 26 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
                    
                        ElseIf Cells(i, J) = "!Xref Error" And J = 28 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
            
                        ElseIf Cells(i, J) = "" And J = 29 And Cells(i, 25) <> "REVENUE" Then
                            Cells(i, 25).Font.Bold = True
                            Cells(i, 25).Interior.ColorIndex = 2
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
            
                        ElseIf Cells(i, J) = "" And J = 41 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
                    
                    End If
            
                    'Count the number of errors in each row
                        If Cells(i, J).Font.Bold = True Then
                            Error_Count = Error_Count + 1
                        End If
                 
                Next J
            
                            
                'Designate the errors
                    If Error_Count > 1 Then
                        Range("AS" & i).Value = "Yes"
                        Range("AS" & i).Font.Bold = True
                        Range("AS" & i).Interior.ColorIndex = 3
                        
                        Range("AX" & i).Value = Error_Count
                                                
                        
                        'Indicate which errors are present
                        
                            Error_Count_Clm = Error_Count
                            
                            'Partner CC
                                If Range("E" & i).Font.Bold = True Then
                                   Range("AT" & i).Value = "Yes"
                                   Range("AT" & i).Font.Bold = True
                                   Error_Count_Clm = Error_Count_Clm - 1
                                   Range("AY" & i).Value = Error_Count_Clm
                                
                                    Else
                                        Range("AT" & i).Value = "No"
                                        Range("AY" & i).Value = Error_Count_Clm
                                
                                End If
                                
                            
                            'Prt Actt
                                If Range("AB" & i).Font.Bold = True Then
                                    Range("AU" & i).Value = "Yes"
                                    Range("AU" & i).Font.Bold = True
                                    Error_Count_Clm = Error_Count_Clm - 1
                                    Range("AZ" & i).Value = Error_Count_Clm
                                
                                    Else
                                        Range("AU" & i).Value = "No"
                                        Range("AZ" & i).Value = Error_Count_Clm
                                
                                End If
                            
                            
                            'Other Errors
                                If Error_Count_Clm > 0 Then
                                    Range("AV" & i).Value = "Yes"
                                    Range("AV" & i).Font.Bold = True
                                    Error_Count_Clm = Error_Count_Clm - 1
                                    Range("BA" & i).Value = Error_Count_Clm
                                    
                                    Else
                                        Range("AV" & i).Value = "No"
                                        Range("BA" & i).Value = Error_Count_Clm
                                
                                End If
                            
                                
                        Range("A" & i & ":BA" & i).Copy Sheets("Error.Items").Range("C" & Error_Row)
                        Sheets("Error.Items").Range("A" & Error_Row).Value = ActiveSheet.Name
                        Sheets("Error.Items").Range("B" & Error_Row).Value = i
                        Error_Row = Error_Row + 1
                
                    End If


            Next i


        Next
    
    End If
    
Next




'Sort the data
    'Find the last row first
        Sheets("Error.Items").Activate
        LastRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
            LookIn:=xlFormulas, SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, MatchCase:=False).Row
    
    'Sorting the Tab Names in Order
        With Sheets("Error.Items").Sort
            .SortFields.Add Key:=Range("A3"), Order:=xlAscending
            .SortFields.Add Key:=Range("B3"), Order:=xlAscending
            .SetRange Range("A3:AV" & LastRow)
            .Header = xlNo
            .Apply
        End With




'Formatting the "Error.Items" tab to autofit
    Sheets("Error.Items").Columns("A:AX").EntireColumn.AutoFit




'Turn on alerts, screen updates, and calculate
        'Turn On Display Alerts
            Application.DisplayAlerts = True


        'Turn on Screen Update
            Application.ScreenUpdating = True


        'Turn off Automatic Calculations
            Calculate


'Freeze Panes on the "Error.Items" Tab and places the cursor in cell C3
        Sheets("Error.Items").Activate
        Sheets("Error.Items").Range("C3").Select
        ActiveWindow.FreezePanes = False
        ActiveWindow.FreezePanes = True


End Sub
 
Sort by date Sort by votes

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Post the link to the dropbox file...I think you have to click on share !
 
Last edited:
Upvote 0
Michael M, do I just post the link or can I private message it to you? I prefer to private message.
 
Upvote 0
Sending it by PM means only one person gets to help with your problem !
and any solution arrived at will be posted back to the board anyway.
 
Last edited:
Upvote 0
I'm okay with that just to see if you can solve it as I don't want the file floating around as I'm concerned with the data. If you get a solution to fixing the code, that's fine.
 
Upvote 0
We can post the solution so everyone has access to that because that's what important.

Thanks Michael M for all your help!
 
Upvote 0
One thing we don't do is open zipped files ......:diablo:...!!
 
Upvote 0
Is this code slow ???
I ran the file through my anti virus then opened it.
After looking at the code on a working file, I'd suggest simply deleting the duplicates on the error sheet.
The code is nothing like the way I would have written, but I'm not going to try and rewrite it !!
Try using this code to replace ALL of yours

Code: 
Sub Error_Check()

'Turn off alerts, screen updates, and automatic calculation
        'Turn off Display Alerts
            Application.DisplayAlerts = False

        'Turn off Screen Update
            Application.ScreenUpdating = False

        'Turn off Automatic Calculations
            Application.Calculation = xlManual


'Dimensioning
    Dim LastRow As Long
    Dim Error_Row As Long
    Dim Error_Count As Long
    Dim Error_Count_Clm As Long
    Dim i As Long, J As Long, k As Long
    
    Dim X As Long


'Clear the existing errors
    'Find the last row first
        Sheets("Error.Items").Activate
        LastRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
            LookIn:=xlFormulas, SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, MatchCase:=False).Row
    
    'Check to see if any data exists
        If LastRow > 2 Then
            'Clear the existing data
                Sheets("Error.Items").Range("A3:BA" & LastRow).Clear
        End If



'Looping through all the tabs to find the errors
    Error_Row = 3
    
    For Each Sheet In ActiveWorkbook.Worksheets
        If Sheet.Name = "Error.Items" Or Sheet.Name = "JIBs.End" Then
            For X = Sheets("JIBs.End").Index - 1 To Sheets("Error.Items").Index + 1 Step -1

        'Find the last row of data
            Sheets(X).Activate
            
            LastRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
                    LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, MatchCase:=False).Row
            
            Error_Count = 0


            For i = 3 To LastRow
        
                Error_Count = 0
        
                For J = 1 To 41

                    If J = 1 Or J = 2 Or J = 6 Or J = 7 _
                        Or J = 8 Or J = 9 Or J = 10 Or J = 11 Or J = 12 _
                        Or J = 9 Or J = 10 Or J = 11 Or J = 12 Or J = 14 _
                        Or J = 15 Or J = 17 Or J = 19 Or J = 20 Or J = 21 _
                        Or J = 22 Or J = 23 Or J = 24 Or J = 27 _
                        Or J = 30 Or J = 31 Or J = 32 Or J = 33 Or J = 34 _
                        Or J = 35 Or J = 36 Or J = 37 Or J = 38 Or J = 39 _
                        Or J = 40 Then
                            'do nothing

                        ElseIf Cells(i, J) = "" And J = 3 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
            
                        ElseIf Cells(i, J) = "No CC Xref" And J = 5 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
            
                        ElseIf J = 5 Then
                            If Cells(i, J) = "" Or Cells(i, J) = "No CC Xref" Then
                                Cells(i, J).Font.Bold = True
                                Cells(i, J).Interior.ColorIndex = 3
                            End If
            
                        ElseIf J = 13 Then
                            If Cells(i, J) <> 1 And Cells(i, J) <> 3 Then
                                Cells(i, J).Font.Bold = True
                                Cells(i, J).Interior.ColorIndex = 3
                            End If
            
                        ElseIf Cells(i, J) = "" And J = 16 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
                
                        ElseIf Cells(i, J) = "" And J = 18 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
            
                        ElseIf Cells(i, J) = "" And J = 26 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
                    
                        ElseIf Cells(i, J) = "!Xref Error" And J = 28 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
            
                        ElseIf Cells(i, J) = "" And J = 29 And Cells(i, 25) <> "REVENUE" Then
                            Cells(i, 25).Font.Bold = True
                            Cells(i, 25).Interior.ColorIndex = 2
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
            
                        ElseIf Cells(i, J) = "" And J = 41 Then
                            Cells(i, J).Font.Bold = True
                            Cells(i, J).Interior.ColorIndex = 3
                    
                    End If
            
                    'Count the number of errors in each row
                        If Cells(i, J).Font.Bold = True Then
                            Error_Count = Error_Count + 1
                        End If
                 
                Next J
            
                            
                'Designate the errors
                    If Error_Count > 0 Then
                        Range("AS" & i).Value = "Yes"
                        Range("AS" & i).Font.Bold = True
                        Range("AS" & i).Interior.ColorIndex = 3
                        
                        Range("AX" & i).Value = Error_Count
                                                
                        
                        'Indicate which errors are present
                        
                            Error_Count_Clm = Error_Count
                            
                            'Partner CC
                                If Range("E" & i).Font.Bold = True Then
                                   Range("AT" & i).Value = "Yes"
                                   Range("AT" & i).Font.Bold = True
                                   Error_Count_Clm = Error_Count_Clm - 1
                                   Range("AY" & i).Value = Error_Count_Clm
                                
                                    Else
                                        Range("AT" & i).Value = "No"
                                        Range("AY" & i).Value = Error_Count_Clm
                                
                                End If
                                
                            
                            'Prt Actt
                                If Range("AB" & i).Font.Bold = True Then
                                    Range("AU" & i).Value = "Yes"
                                    Range("AU" & i).Font.Bold = True
                                    Error_Count_Clm = Error_Count_Clm - 1
                                    Range("AZ" & i).Value = Error_Count_Clm
                                
                                    Else
                                        Range("AU" & i).Value = "No"
                                        Range("AZ" & i).Value = Error_Count_Clm
                                
                                End If
                            
                            
                            'Other Errors
                                If Error_Count_Clm > 0 Then
                                    Range("AV" & i).Value = "Yes"
                                    Range("AV" & i).Font.Bold = True
                                    Error_Count_Clm = Error_Count_Clm - 1
                                    Range("BA" & i).Value = Error_Count_Clm
                                    
                                    Else
                                        Range("AV" & i).Value = "No"
                                        Range("BA" & i).Value = Error_Count_Clm
                                
                                End If
                            
                                
                        Range("A" & i & ":BA" & i).Copy Sheets("Error.Items").Range("C" & Error_Row)
                        Sheets("Error.Items").Range("A" & Error_Row).Value = ActiveSheet.Name
                        Sheets("Error.Items").Range("B" & Error_Row).Value = i
                        Error_Row = Error_Row + 1
                
                    End If

            Next i

        Next
    
    End If
    
Next


'Sort the data
    'Find the last row first
        Sheets("Error.Items").Activate
        LastRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
            LookIn:=xlFormulas, SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, MatchCase:=False).Row
    
    'Sorting the Tab Names in Order
        With Sheets("Error.Items").Sort
            .SortFields.Add Key:=Range("A3"), Order:=xlAscending
            .SortFields.Add Key:=Range("B3"), Order:=xlAscending
            .SetRange Range("A3:BA" & LastRow)
            .Header = xlNo
            .Apply
        End With

Dim r As Long, lr As Long
lr = Sheets("Error.Items").Cells(Rows.Count, "B").End(xlUp).Row
    For r = lr To 2 Step -1
        If Cells(r, 2).Value = Cells(r - 1, 2).Value Then
            Rows(r).Delete
        End If
    Next r
        

'Formatting the "Error.Items" tab to autofit
    Sheets("Error.Items").Columns("A:AX").EntireColumn.AutoFit


'Turn on alerts, screen updates, and calculate
        'Turn On Display Alerts
            Application.DisplayAlerts = True

        'Turn on Screen Update
            Application.ScreenUpdating = True

        'Turn off Automatic Calculations
            Calculate

'Freeze Panes on the "Error.Items" Tab and places the cursor in cell C3
        Sheets("Error.Items").Activate
        Sheets("Error.Items").Range("C3").Select
        ActiveWindow.FreezePanes = False
        ActiveWindow.FreezePanes = True

End Sub
 
Upvote 0
Make a copy of the workbook and try this code

Code: 
Sub Error_Check()

'Turn off alerts, screen updates, and automatic calculation
'Turn off Display Alerts
    With Application
        .DisplayAlerts = False
        'Turn off Screen Update
        .ScreenUpdating = False
        'Turn off Automatic Calculations
        .Calculation = xlManual
    End With

'Dimensioning
Dim LastRow As Long, Error_Row As Long, Error_Count As Long, ws As Worksheet
Dim Error_Count_Clm As Long, i As Long, J As Long, k As Long, X As Long


'Clear the existing errors
'Find the last row first
    With Sheets("Error.Items")
        LastRow = .Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
        LookIn:=xlFormulas, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False).Row
        
        'Check to see if any data exists
            If LastRow > 2 Then
            'Clear the existing data
                .Range("A3:BA" & LastRow).Clear
            End If
    End With


'Looping through all the tabs to find the errors
Error_Row = 3

For Each ws In Worksheets
    If ws.Name <> "Error.Items" And ws.Name <> "JIBs.End" And ws.Name <> "Start" And ws.Name <> "End" Then
        
        'Find the last row of data
                ws.Activate
                LastRow = ws.Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
                LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, MatchCase:=False).Row
                Error_Count = 0
                            For i = 3 To LastRow
                            Error_Count = 0
                                For J = 1 To 41
                                    If J = 3 Or J = 5 Or J = 13 Or J = 16 Or J = 18 Or J = 25 Or J = 26 Or J = 28 Or J = 29 Or J = 41 Then
                                    
                                        If Cells(i, J) = "" Or Cells(i, J) = "No CC Xref" Or Cells(i, J) = "!Xref Error" Then
                                            Cells(i, J).Font.Bold = True
                                            Cells(i, J).Interior.ColorIndex = 3
                                        End If
                                        If J = 13 And Cells(i, J) <> 1 And Cells(i, J) <> 3 Then
                                            Cells(i, J).Font.Bold = True
                                            Cells(i, J).Interior.ColorIndex = 3
                                        End If
                                        If Cells(i, J) = "" And Cells(i, 25) <> "REVENUE" Then
                                            Cells(i, 25).Font.Bold = True
                                            Cells(i, 25).Interior.ColorIndex = 2
                                            Cells(i, J).Font.Bold = True
                                            Cells(i, J).Interior.ColorIndex = 3
                                        End If
                                        
                                        'Count the number of errors in each row
                                        If Cells(i, J).Font.Bold = True Then
                                            Error_Count = Error_Count + 1
                                        End If
                                    
                                    End If
                                Next J
                            
                            
                            'Designate the errors
                                        If Error_Count > 0 Then
                                            Range("AS" & i).Value = "Yes"
                                            Range("AS" & i).Font.Bold = True
                                            Range("AS" & i).Interior.ColorIndex = 3
                                            
                                            Range("AX" & i).Value = Error_Count
                                                
                                            
                                            'Indicate which errors are present
                                            
                                            Error_Count_Clm = Error_Count
                                        
                                        'Partner CC
                                                If Range("E" & i).Font.Bold = True Then
                                                    Range("AT" & i).Value = "Yes"
                                                    Range("AT" & i).Font.Bold = True
                                                    Error_Count_Clm = Error_Count_Clm - 1
                                                    Range("AY" & i).Value = Error_Count_Clm
                                                    
                                                    Else
                                                    Range("AT" & i).Value = "No"
                                                    Range("AY" & i).Value = Error_Count_Clm
                                                
                                                End If
                                        
                                        
                                        'Prt Actt
                                                If Range("AB" & i).Font.Bold = True Then
                                                    Range("AU" & i).Value = "Yes"
                                                    Range("AU" & i).Font.Bold = True
                                                    Error_Count_Clm = Error_Count_Clm - 1
                                                    Range("AZ" & i).Value = Error_Count_Clm
                                                    
                                                    Else
                                                    Range("AU" & i).Value = "No"
                                                    Range("AZ" & i).Value = Error_Count_Clm
                                                
                                                End If
                            
                            
                            'Other Errors
                                                If Error_Count_Clm > 0 Then
                                                    Range("AV" & i).Value = "Yes"
                                                    Range("AV" & i).Font.Bold = True
                                                    Error_Count_Clm = Error_Count_Clm - 1
                                                    Range("BA" & i).Value = Error_Count_Clm
                                                    
                                                    Else
                                                    Range("AV" & i).Value = "No"
                                                    Range("BA" & i).Value = Error_Count_Clm
                                                
                                                End If
                                                
                            
                                                Range("A" & i & ":BA" & i).Copy Sheets("Error.Items").Range("C" & Error_Row)
                                                Sheets("Error.Items").Range("A" & Error_Row).Value = ActiveSheet.Name
                                                Sheets("Error.Items").Range("B" & Error_Row).Value = i
                                                Error_Row = Error_Row + 1
                                            
                                            End If
                            
                            Next i
                
        
    End If

Next ws


'Sort the data
'Find the last row first
Sheets("Error.Items").Activate
LastRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row

'Sorting the Tab Names in Order
With Sheets("Error.Items").Sort
.SortFields.Add Key:=Range("A3"), Order:=xlAscending
.SortFields.Add Key:=Range("B3"), Order:=xlAscending
.SetRange Range("A3:BA" & LastRow)
.Header = xlNo
.Apply
End With


'Formatting the "Error.Items" tab to autofit
Sheets("Error.Items").Columns("A:AX").EntireColumn.AutoFit


'Turn on alerts, screen updates, and calculate
    With Application
        'Turn On Display Alerts
        .DisplayAlerts = True
        'Turn on Screen Update
        Application.ScreenUpdating = True
        'Turn off Automatic Calculations
        Calculate
    End With
'Freeze Panes on the "Error.Items" Tab and places the cursor in cell C3
Sheets("Error.Items").Activate
Sheets("Error.Items").Range("C3").Select
ActiveWindow.FreezePanes = False
ActiveWindow.FreezePanes = True

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
how to automatically clear text if text in another cell is removed
Replies
1
Views
111
Joe4
Joe4
A
  • Solved
doesn't show data in listbox on form without any error in this code
Replies
6
Views
116
Abdo
A
A
  • Question Question
VBA for setting up the printing pages per sheet
Replies
0
Views
494
Aurum1
A
R
  • Question Question
VBA - AUTO FIT, Can we remove make the sum formula in below code
Replies
1
Views
157
Joe4
Joe4
T
  • Question Question
VBA Macro suddenly extremely slow. Need help in how to edit it.
Replies
3
Views
263
bobsan42
bobsan42

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,631
Latest member
a_potato

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