Ok... this one is killing me. I have this code, below, that works quite well. It allows a user to select any range they want to clear the non-formula cells of. It checks to make sure it's not attempting to clear too many rows at one... it checks to make sure that they're within the clearable range. It works perfectly!
Except for one thing... after the "selection.clearcontents" command near the end of the code, the thing just stops... That's right. It just stops. My status bar is not turned back to false. My workbook remains unprotected. I cannot break the code because it seems to think that there is no code running. It's as if the code is still running but since I can't break it, it clearly isn't.
I appreciate any advice anyone has to offer.
Take care.
Except for one thing... after the "selection.clearcontents" command near the end of the code, the thing just stops... That's right. It just stops. My status bar is not turned back to false. My workbook remains unprotected. I cannot break the code because it seems to think that there is no code running. It's as if the code is still running but since I can't break it, it clearly isn't.
I appreciate any advice anyone has to offer.
Take care.
Code:
Sub ClearRowContents()
On Error GoTo ErrorMessage
'----------------------------------------------------------------------------------------------------
'Check to ensure proper sheet is active
Application.StatusBar = "Confirming active worksheet..."
If ActiveSheet.Name <> "Data Entry" Then
MsgBox "This macro can only be run from the 'Data Entry' worksheet.", vbExclamation + vbOKOnly, "Macro Cannot Continue"
GoTo ErrorExit
End If
'------------------------------------------------------------------------------------------------------------------
' Prepare Macro
With Application
.StatusBar = "Preparing the macro..."
.ScreenUpdating = False
.EnableEvents = False
End With
'----------------------------------------------------------------------------------------------------
'Establish variables
Application.StatusBar = "Establishing variables..."
Dim strOriginalSelection As String
Dim lngActiveRow As Long
Dim R As Range
Dim RR As Range
Dim lngRowCount As Long
Dim strRows As String
Dim strRowsRange As String
Dim strRowsOrRow As String
Dim strRowsOrRowReminder As String
'----------------------------------------------------------------------------------------------------
'Set default variables
Application.StatusBar = "Setting default variables..."
strOriginalSelection = Selection.Address
lngActiveRow = ActiveCell.Row
strRows = ""
strRowsRange = ""
lngRowCount = 0
'----------------------------------------------------------------------------------------------------
'Set row range variables
Application.StatusBar = "Setting row range variables..."
For Each rw In Selection.Rows
lngRowCount = lngRowCount + 1
strRows = strRows & rw.Row & ", " '<---- HARD REFERENCE
strRowsRange = strRowsRange & "$A$" & rw.Row & ":$BJ$" & rw.Row & "," '<---- HARD REFERENCE
If (lngRowCount >= 30) Then
MsgBox "The macro cannot continue. " & _
"You can only clear up to 30 rows at a time. " & _
vbNewLine & "You have attempted to clear " & lngRowCount & " rows which, of course, is too many. " & _
vbNewLine & "Please reduce your selection and try again.", _
vbExclamation + vbOKOnly, "Too Many Rows Selected"
GoTo ErrorExit
End If
If (rw.Row <= 8) Or (rw.Row >= 308) Then
MsgBox "The macro cannot continue. " & _
"One or more of the rows you selected to be cleared is not within the allowable range. " & _
"The first row to experience this problem is row " & rw.Row & ".", _
vbExclamation + vbOKOnly, "Unallowable Range Selected"
GoTo ErrorExit
End If
Next rw
strRows = Left(strRows, Len(strRows) - 2)
strRowsRange = Left(strRowsRange, Len(strRowsRange) - 1)
'----------------------------------------------------------------------------------------------------
'Set messagebox variables to accomodate for single row or multiple row selections
If lngRowCount = 1 Then
strRowsOrRow = ""
strRowsOrRowReminder = vbNewLine & vbNewLine & "For future reference remember, you can select multiple rows at a time."
Else
strRowsOrRow = "s"
strRowsOrRowReminder = ""
End If
'----------------------------------------------------------------------------------------------------
'Confirm clear row contents
Application.StatusBar = "Confirming the action by the user..."
If MsgBox("Are you certain you wish to clear the non-formula contents of the following row" & strRowsOrRow & "?" & _
vbNewLine & vbNewLine & strRows & _
strRowsOrRowReminder & _
vbNewLine & vbNewLine & vbNewLine & vbNewLine & "!!! IF YOU PRESS 'YES' THIS OPERATION CANNOT BE UNDONE !!!", _
vbQuestion + vbYesNo, "Confirm Clear Contents?") = vbNo Then
MsgBox "You chose not to clear the contents of the identified row" & strRowsOrRow & ".", _
vbInformation + vbOKOnly, "No Action Performed"
GoTo ErrorExit
End If
'----------------------------------------------------------------------------------------------------
'Select only non-formula cells in active row
Application.StatusBar = "Selecting only the non-formula cells in the active row" & strRowsOrRow & "..."
Range(strRowsRange).Select
For Each R In Selection.Cells
If R.HasFormula = False Then
If RR Is Nothing Then
Set RR = R
Else
Set RR = Application.Union(RR, R)
End If
End If
Next R
'----------------------------------------------------------------------------------------------------
'Clear Contents of Current Row
Application.StatusBar = "Clearing the contents of the active row" & strRowsOrRow & "..."
If Not RR Is Nothing Then
RR.Select
Selection.ClearContents
End If
'----------------------------------------------------------------------------------------------------
'Return to original cell
Application.StatusBar = "Returning to the original cell..."
Range(strOriginalSelection).Select
ErrorExit:
Call ProtectAll
With Application
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
End With
Exit Sub
ErrorMessage:
MsgBox "The following error has arisen:" & _
vbNewLine & " Number:" & vbTab & Err.Number & _
vbNewLine & " Project Source:" & vbTab & Err.Source & _
vbNewLine & " Status Bar:" & vbTab & Application.StatusBar & _
vbNewLine & " Description:" & vbTab & Err.Description, _
vbCritical + vbOKOnly, "Macro Has Failed"
GoTo ErrorExit
End Sub
