code waiting indefinitely

So when I run this code am I now getting the wait hourglass type symbol in Excel and it does not go away. Can someone please help. I am using this code on multiple sheets and I need this wait stuff to stop.

The problem started after I edited the following:

'Sheets("Sheet1").Activate - notice this is no longer active so I can run this on more than one sheet.

And changed this:

'intHowMany = Range("I1").Value

to this
 Let intHowMany = Application.InputBox("Number of 'combinations' allowed", Type:=1)


Sub RemoveSequentialNumberDups()



Dim lngDataRow As Long
Dim lngFirstDataRow As Long
Dim lngLastDataRow As Long
Dim lngFirstDataCol As Long
Dim strFirstDataCol As String
Dim strLastDataCol As String
Dim lngCol As Long

Dim intMatch As Integer
Dim lngLeft As Long
Dim bDoneWithRow As Boolean
Dim vData As Variant
Dim intHowMany As Integer
Dim rngToCheck As Range
Dim rngData As Range
Dim strColTBD As String

'Sheets("Sheet1").Activate

lngLastDataRow = Cells(Rows.Count, 2).End(xlUp).Row

' Determine the first data row
For lngFirstDataRow = 1 To 1000
    If Cells(lngFirstDataRow, 4).Value <> "" Then
        Exit For
    End If
Next
' And the first data column
For lngFirstDataCol = 1 To 20
    If Cells(lngFirstDataRow, lngFirstDataCol).Value <> "" Then
        Exit For
    End If
Next
strFirstDataCol = Split(Cells(lngFirstDataRow, lngFirstDataCol).Address, "$")(1)
strLastDataCol = Split(Cells(lngFirstDataRow, lngFirstDataCol).Offset(0, 4).Address, "$")(1)
strColTBD = Split(Cells(lngFirstDataRow, lngFirstDataCol).Offset(0, 5).Address, "$")(1)

On Error Resume Next
Set rngData = Application.InputBox("Select the data range", "Data Selection", strFirstDataCol & lngFirstDataRow & ":" & strLastDataCol & lngLastDataRow, Type:=8)
If rngData Is Nothing Then
    MsgBox "You pressed Cancel"
    Exit Sub
End If
On Error GoTo 0
Debug.Print Now()

DoEvents
Application.ScreenUpdating = False
Application.Cursor = xlWait

vData = Range(strFirstDataCol & rngData.Row & ":" & strLastDataCol & rngData.Row + rngData.Rows.Count - 1).Value

'intHowMany = Range("I1").Value
 Let intHowMany = Application.InputBox("Number of 'combinations' allowed", Type:=1)

' Look at each data row
For lngDataRow = 1 To UBound(vData)
    bDoneWithRow = False
    If lngDataRow Mod 1000 = 0 Then
        Application.StatusBar = "Rows remaining to be examined: " & FormatNumber(lngLastDataRow - lngDataRow, 0)
    End If
    ' Initialize the match counter
    intMatch = 0
    For lngCol = 1 To 4
        If bDoneWithRow Then
            Exit For
        End If
        If vData(lngDataRow, lngCol) + 1 = vData(lngDataRow, lngCol + 1) Then
            intMatch = intMatch + 1
            If intMatch > intHowMany Then
                bDoneWithRow = True
                ' Put "TBD" (= To Be Deleted( in the first unused column after the data of the data row
                Cells(lngDataRow + lngFirstDataRow - 1, lngFirstDataCol + 5) = "TBD"
                ' One of the match criteria rows has enough matches so we don't need to
                ' look at the rest of them
                Exit For
            End If
        End If
    Next
Next

' Delete the TBD rows via AutoFilter
Application.StatusBar = "Deleting. Please wait."

Set rngToCheck = Range(strColTBD & rngData.Row - 1 & ":" & strColTBD & rngData.Rows.Count + lngFirstDataRow - 1)

With rngToCheck
    .AutoFilter Field:=1, Criteria1:="TBD"
    
    On Error Resume Next
    ' Delete the visible rows which are all "TBD"
    '.Resize(.Rows.Count, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    'remove the autofilter
    .AutoFilter
End With

' Remove the autofiler dropdown
Range(strColTBD & rngData.Row).ClearContents
On Error GoTo 0

Application.ScreenUpdating = True
lngLeft = Cells(Rows.Count, 4).End(xlUp).Row
Application.Speech.Speak "Deletions completed"
MsgBox FormatNumber(lngLastDataRow - lngLeft, 0) & " rows deleted"
Debug.Print Now()

Application.StatusBar = False
Application.Cursor = xlDefault
End Sub

Open in new window

Pedrov664Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

byundtMechanical EngineerCommented:
Screen updating must not be turned off if you want to use Application.InputBox or InputBox. If not, the code waits until you respond to the invisible InputBox.

Move statement 52 after statement 58.
0
broro183Commented:
hi,

Rather than moving line 52 after line 58, another option would be to move line 58 to nearer the beginning of the macro. From a quick glance it doesn't appear to matter when the question is asked so I would place near the start of the macro. My reasoning for this is that I try to do any interaction at either the very start or the very end of macros. For example, setup at the start of a macro & feedback at the end of the macro. This prevents a macro from "waiting" for input when it is part way through, in other words I like to be able to start a macro & then let it do what is required while I work on other tasks.

hth
Rob
0
Pedrov664Author Commented:
Rob,

I like your idea, but please remember I am not a programmer so I do not know exactly where to move it. Please specify a line number, i would hate for it to hang up again.

Byundt,

Wouldn't I have to move all of the following lines of code as a group?

DoEvents
Application.ScreenUpdating = False
Application.Cursor = xlWait

Open in new window


BTW, congratulations, I see you're listed as a sage under top MS Excel Expert of the Year.

Byundt and Rob,

I am also having trouble with another code that stopped midstream. Please refer to my post from this morning for that one. If any of you can help it would be greatly appreciated since I see that you're both experts in your field.
0
Exploring SharePoint 2016

Explore SharePoint 2016, the web-based, collaborative platform that integrates with Microsoft Office to provide intranets, secure document management, and collaboration so you can develop your online and offline capabilities.

byundtMechanical EngineerCommented:
Pedrov664,
You didn't post a sample workbook, so I couldn't actually test the code--but I moved the Application.InputBox to a position just before you turned screen updating off. If this change isn't fixing the problem for you, could you please post a sample workbook?
Sub RemoveSequentialNumberDups()



Dim lngDataRow As Long
Dim lngFirstDataRow As Long
Dim lngLastDataRow As Long
Dim lngFirstDataCol As Long
Dim strFirstDataCol As String
Dim strLastDataCol As String
Dim lngCol As Long

Dim intMatch As Integer
Dim lngLeft As Long
Dim bDoneWithRow As Boolean
Dim vData As Variant
Dim intHowMany As Integer
Dim rngToCheck As Range
Dim rngData As Range
Dim strColTBD As String

'Sheets("Sheet1").Activate

lngLastDataRow = Cells(Rows.Count, 2).End(xlUp).Row

' Determine the first data row
For lngFirstDataRow = 1 To 1000
    If Cells(lngFirstDataRow, 4).Value <> "" Then
        Exit For
    End If
Next
' And the first data column
For lngFirstDataCol = 1 To 20
    If Cells(lngFirstDataRow, lngFirstDataCol).Value <> "" Then
        Exit For
    End If
Next
strFirstDataCol = Split(Cells(lngFirstDataRow, lngFirstDataCol).Address, "$")(1)
strLastDataCol = Split(Cells(lngFirstDataRow, lngFirstDataCol).Offset(0, 4).Address, "$")(1)
strColTBD = Split(Cells(lngFirstDataRow, lngFirstDataCol).Offset(0, 5).Address, "$")(1)

On Error Resume Next
Set rngData = Application.InputBox("Select the data range", "Data Selection", strFirstDataCol & lngFirstDataRow & ":" & strLastDataCol & lngLastDataRow, Type:=8)
If rngData Is Nothing Then
    MsgBox "You pressed Cancel"
    Exit Sub
End If
On Error GoTo 0
Debug.Print Now()

'intHowMany = Range("I1").Value
 Let intHowMany = Application.InputBox("Number of 'combinations' allowed", Type:=1)

DoEvents
Application.ScreenUpdating = False
Application.Cursor = xlWait

vData = Range(strFirstDataCol & rngData.Row & ":" & strLastDataCol & rngData.Row + rngData.Rows.Count - 1).Value

' Look at each data row
For lngDataRow = 1 To UBound(vData)
    bDoneWithRow = False
    If lngDataRow Mod 1000 = 0 Then
        Application.StatusBar = "Rows remaining to be examined: " & FormatNumber(lngLastDataRow - lngDataRow, 0)
    End If
    ' Initialize the match counter
    intMatch = 0
    For lngCol = 1 To 4
        If bDoneWithRow Then
            Exit For
        End If
        If vData(lngDataRow, lngCol) + 1 = vData(lngDataRow, lngCol + 1) Then
            intMatch = intMatch + 1
            If intMatch > intHowMany Then
                bDoneWithRow = True
                ' Put "TBD" (= To Be Deleted( in the first unused column after the data of the data row
                Cells(lngDataRow + lngFirstDataRow - 1, lngFirstDataCol + 5) = "TBD"
                ' One of the match criteria rows has enough matches so we don't need to
                ' look at the rest of them
                Exit For
            End If
        End If
    Next
Next

' Delete the TBD rows via AutoFilter
Application.StatusBar = "Deleting. Please wait."

Set rngToCheck = Range(strColTBD & rngData.Row - 1 & ":" & strColTBD & rngData.Rows.Count + lngFirstDataRow - 1)

With rngToCheck
    .AutoFilter Field:=1, Criteria1:="TBD"
    
    On Error Resume Next
    ' Delete the visible rows which are all "TBD"
    '.Resize(.Rows.Count, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    'remove the autofilter
    .AutoFilter
End With

' Remove the autofiler dropdown
Range(strColTBD & rngData.Row).ClearContents
On Error GoTo 0

Application.ScreenUpdating = True
lngLeft = Cells(Rows.Count, 4).End(xlUp).Row
Application.Speech.Speak "Deletions completed"
MsgBox FormatNumber(lngLastDataRow - lngLeft, 0) & " rows deleted"
Debug.Print Now()

Application.StatusBar = False
Application.Cursor = xlDefault
End Sub

Open in new window

Brad
0
Pedrov664Author Commented:
Brad,

Ran the code above and am including the workbook. What I got is:

Run-time error '13:'

Type mismatch

and it highlights the following code:

If vData(lngDataRow, lngCol) + 1 = vData(lngDataRow, lngCol + 1) Then

The other problem is that the 'hourglass' does not go away after the run.

P.S. part of the reason I did not post the code is that it would take a while and still not load the file. This is attempt # 4
MatchingCombinations.xlsm
0
byundtMechanical EngineerCommented:
Which worksheet should I test the macro on?
How many combinations should I allow for testing?
0
Pedrov664Author Commented:
I ran into problem on 6 with 1 combination. You will note there are items marked for deletion and were not deleted since it stopped midstream
0
byundtMechanical EngineerCommented:
The problem with Type mismatch (using 3 combinations) was the presence of XX DELETE XX in column B. I added a test for non-numeric data, and that overcame the issue.

I commented out the statement for DoEvents. I added a test for the user-specified number of inputs to allow being less than 0. And I made sure that the first cell in rngToCheck had a value so it could be AutoFilter.
Sub RemoveSequentialNumberDups()

Dim lngDataRow As Long
Dim lngFirstDataRow As Long
Dim lngLastDataRow As Long
Dim lngFirstDataCol As Long
Dim strFirstDataCol As String
Dim strLastDataCol As String
Dim lngCol As Long

Dim intMatch As Integer
Dim lngLeft As Long
Dim bDoneWithRow As Boolean
Dim vData As Variant
Dim intHowMany As Integer
Dim rngToCheck As Range
Dim rngData As Range
Dim strColTBD As String

'Sheets("Sheet1").Activate

lngLastDataRow = Cells(Rows.Count, 2).End(xlUp).Row

' Determine the first data row
For lngFirstDataRow = 1 To 1000
    If Cells(lngFirstDataRow, 4).Value <> "" Then
        Exit For
    End If
Next
' And the first data column
For lngFirstDataCol = 1 To 20
    If Cells(lngFirstDataRow, lngFirstDataCol).Value <> "" Then
        Exit For
    End If
Next
strFirstDataCol = Split(Cells(lngFirstDataRow, lngFirstDataCol).Address, "$")(1)
strLastDataCol = Split(Cells(lngFirstDataRow, lngFirstDataCol).Offset(0, 4).Address, "$")(1)
strColTBD = Split(Cells(lngFirstDataRow, lngFirstDataCol).Offset(0, 5).Address, "$")(1)

On Error Resume Next
Set rngData = Application.InputBox("Select the data range", "Data Selection", strFirstDataCol & lngFirstDataRow & ":" & strLastDataCol & lngLastDataRow, Type:=8)
If rngData Is Nothing Then
    MsgBox "You pressed Cancel"
    Exit Sub
End If
On Error GoTo 0
Debug.Print Now()

'intHowMany = Range("I1").Value
 Let intHowMany = Application.InputBox("Number of 'combinations' allowed", Type:=1)
 If intHowMany < 1 Then Exit Sub

'DoEvents
Application.ScreenUpdating = False
Application.Cursor = xlWait

vData = Range(strFirstDataCol & rngData.Row & ":" & strLastDataCol & rngData.Row + rngData.Rows.Count - 1).Value

' Look at each data row
For lngDataRow = 1 To UBound(vData)
    bDoneWithRow = False
    If lngDataRow Mod 1000 = 0 Then
        Application.StatusBar = "Rows remaining to be examined: " & FormatNumber(lngLastDataRow - lngDataRow, 0)
    End If
    ' Initialize the match counter
    intMatch = 0
    For lngCol = 1 To 4
        If bDoneWithRow Then
            Exit For
        End If
        If IsNumeric(vData(lngDataRow, lngCol)) Then
            If vData(lngDataRow, lngCol) + 1 = vData(lngDataRow, lngCol + 1) Then
                intMatch = intMatch + 1
                If intMatch > intHowMany Then
                    bDoneWithRow = True
                    ' Put "TBD" (= To Be Deleted( in the first unused column after the data of the data row
                    Cells(lngDataRow + lngFirstDataRow - 1, lngFirstDataCol + 5) = "TBD"
                    ' One of the match criteria rows has enough matches so we don't need to
                    ' look at the rest of them
                    Exit For
                End If
            End If
        End If
    Next
Next

' Delete the TBD rows via AutoFilter
Application.StatusBar = "Deleting. Please wait."

Set rngToCheck = Range(strColTBD & rngData.Row - 1 & ":" & strColTBD & rngData.Rows.Count + lngFirstDataRow - 1)

With rngToCheck
    If rngToCheck.Cells(1, 1) = "" Then rngToCheck.Cells(1, 1) = "TBD"  'AutoFilter won't work if cell is blank
    .AutoFilter Field:=1, Criteria1:="TBD"
    
    On Error Resume Next
    ' Delete the visible rows which are all "TBD"
    '.Resize(.Rows.Count, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    'remove the autofilter
    .AutoFilter
    If rngToCheck.Cells(1, 1) = "TBD" Then rngToCheck.Cells(1, 1).ClearContents
End With

' Remove the autofiler dropdown
Range(strColTBD & rngData.Row).ClearContents
On Error GoTo 0

Application.ScreenUpdating = True
lngLeft = Cells(Rows.Count, 4).End(xlUp).Row
Application.Speech.Speak "Deletions completed"
MsgBox FormatNumber(lngLastDataRow - lngLeft, 0) & " rows deleted"
Debug.Print Now()

Application.StatusBar = False
Application.Cursor = xlDefault
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Pedrov664Author Commented:
ok, I have no idea what you just said but it does seem to work in all but the numbers_6 page. However I simply ordered the list putting all those annoying items on the bottom and deleted them. The other pages seems to work flawlessly.

your code takes the cake.
0
broro183Commented:
hi Pedrov664,

I think you are too generous in your praise of me. I am a mere toddler in comparison to Brad!

However, in saying that, with the right attitude you could soon be at a similar level to me & we can both keep striving towards Brad's level. My thoughts are that I'm...

Always learning & the best way to learn is to experience.
Rob
0
Pedrov664Author Commented:
Rob,

Please forgive me but if you're a toddler in comparison to Brad, what does that make me? I do not even understand simple code editing.

This post is very good example, here I changed one line of code and instead of accomplishing what I wanted I had to rely on someone like yourself, who BTW, considers himself a toddler. I suppose I should get out of the playpen even. I do not belong there. LOL.
0
broro183Commented:
hi Pedrov,

Sorry, I certainly didn't intend to discourage you. If you want to learn,  then the playpen is where you belong. In the playpen we all take the occasional knock from slipping over, or occasionally from a bigger kid, However, there are many more helping hands offered by the big kids than there are hands giving knocks.

There was a time where I didn't even know what vba was & a person was seconded into my workplace to help automate month-end tasks. Seeing this person work & the results of vba automation changed my world - "what, I can now push a button & what used to take me 90 minutes will occur automatically (without errors) in minutes?". I very quickly became passionate about VBA & I joined various online Forums, such as www.TheCodeCage.com & EE, where I could ask questions and learn more about what was possible by reading through any & every thread that caught my eye!
With this increased knowledge through self guided discovery I gradually progressed from being unconsciously incompetent to competence where I now spend time answering questions to help others & also I'm still reading whatever catches my eye to help me keep learning.

I would like to be one of the helpful big kids & with that in mind, I implore you - please disregard my previous statements & stay in the playpen...

Going through code line by line pressing the [F8] button & attempting to understand the next line before pressing [F8] again and then flicking to the view of Excel to see what changes can be a good way to debug code.It also increases your understanding of what code is actually doing & increases your familarity with the Excel Object Model & common syntax of Excel's VBA code.

Always learning & the best way to learn is to experience.
Rob
0
Pedrov664Author Commented:
Rob,

No worries, I understand. I used the analogy to indicate where I stand in comparison to you in scripting languages.

Cheers,
Pedro
0
Pedrov664Author Commented:
BTW, I have some questions that are waiting for someone to answer. Perhaps, you'd like to help with those also.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.