View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
L. Howard L. Howard is offline
external usenet poster
 
Posts: 852
Default .SpecialCells(xlCellTypeBlanks).Delete without going to the sheet

The whole macro is below, which does what I want. It is in a standard module and will be run from any of about 8 to 10 different worksheets.

This snippet deleting blank cells in a range ends up leaving me with the "Project Priorities" sheet as the active sheet.

Sheets("Project Priorities").Activate
Range(Cells(2, blnkCol - 2), Cells(blnkRow, blnkCol)) _
.SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)

How would I return to the original sheet (or never leave it) that I run the code on? I know I should be able to do work on cells on other sheet with no need to select the sheet, but my head is not getting around how to do it if the activesheet can be a different each time the code is executed.

Thanks,
Howard


Sub Delete_Task_Proj_Proir()

Dim tskCel As Range
Dim tskCol As Long
Dim TheTaskRng As Range ' input box selections
Dim aTsk As Range, aTskDel As Range, blkCel As Range
Dim blnkRow As Long, blnkCol As Long


On Error GoTo NotValidInput

Set TheTaskRng = Application.InputBox( _
Prompt:="Select green font COMPLETED Task/s in Column E" & vbCr & _
"For removal from ""Project Priorities"" sheet", Type:=8)

If Not TheTaskRng.Column = 5 Then
MsgBox "Column E cell selection only"
Exit Sub
End If

Application.ScreenUpdating = False

For Each aTsk In TheTaskRng

Set aTskDel = Sheets("Project Priorities").Cells.Find(What:=aTsk, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)


blnkRow = aTskDel.Row
blnkCol = aTskDel.Column


If Not aTskDel Is Nothing Then
aTskDel.Offset(, -2).Resize(1, 3).ClearContents
aTsk.Offset(, 3) = aTsk.Offset(, 3) & "PP Del"
End If

Sheets("Project Priorities").Activate
Range(Cells(2, blnkCol - 2), Cells(blnkRow, blnkCol)) _
.SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)

Next 'aTsk

NotValidInput:
Application.ScreenUpdating = True
End Sub