Deletion Code - Fix please
 

Hi, could someone please help me modify my deletion code as follows:

I need the following code to be slightly modified so that when a user
selects a cell in column Y, then the contents in cells Y:AQ and AY:AZ
are deleted.

For example: if a user selects cell: Y14, then I need the cell contents
Y14:AQ14 and AY14:AZ14 to be deleted.

Sub Deleted_Part_1()


Dim Y_Column As Range

On Error Resume Next

ActiveSheet.Unprotect

Do

Set Y_Column = Application.InputBox("Click in the cell in the
Incumbent's Service column that corresponds with the record you wish to
delete: ", "Please Choose Correct Cell in the Incumbent's Service
column", Cells(ActiveCell.Row, 1).Address, , , , , 8)
If Err.Number < 0 Then
Call OperationCancelled(True)
Exit Sub
End If
Loop Until Y_Column.Column = 1
Call Deleted_Part_2(Y_Column(1))
ActiveWindow.SmallScroll Down:=-65000
Range("A2").Select

End Sub

Sub Deleted_Part_2(Where As Range)

Dim Msg As String
Dim Ans As Long

Where.Select

Msg = "Click on the <OK Button If You Wish To Continue In Deleting
The Current Selected Record, Or Click On the <Cancel Button To Cancel
This Operation"
Ans = MsgBox(Msg, vbOKCancel)

Application.ScreenUpdating = False

If Ans = vbOK Then

ActiveCell.Rows("1:1").EntireRow.Select

Selection.Delete Shift:=xlUp

Range("A2").Select

With Sheets("Data")
'Following line of code is like selecting the last cell
'in the column and holding the Ctrl key and press Up arrow
'It then names the cell.
.Cells(.Rows.Count, "A").End(xlUp).Name = "LastCell"

End With

Range("A2").Select

ActiveWindow.SmallScroll ToRight:=-9

Application.ScreenUpdating = True

Msg = "The Selected Record Is Now Deleted"
Ans = MsgBox(Msg, vbOKOnly)

Range("A2").Select

End If

If Ans = vbCancel Then

Msg = "The Deletion Procedure Has Now Been Cancelled"
Ans = MsgBox(Msg, vbOKOnly)
Exit Sub

End If

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True,
AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions


End Sub

Sub OperationCancelled(Optional Cancelled As Boolean)

MsgBox "You cancelled this operation."

ActiveWindow.SmallScroll ToRight:=-27

End Sub



*** Sent via Developersdex http://www.developersdex.com ***

Deletion Code - Fix please
 

You want to clearcontents instead of delete row

from
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Delete Shift:=xlUp

to
ClearRow = ActiveCell.row
Range("Y" & ClearRow & ":AQ" & ClearRow).ClearContents
Range("AY" & ClearRow & ":AZ" & ClearRow).ClearContents

"Chris Hankin" wrote:

Hi, could someone please help me modify my deletion code as follows:

I need the following code to be slightly modified so that when a user
selects a cell in column Y, then the contents in cells Y:AQ and AY:AZ
are deleted.

For example: if a user selects cell: Y14, then I need the cell contents
Y14:AQ14 and AY14:AZ14 to be deleted.

Sub Deleted_Part_1()


Dim Y_Column As Range

On Error Resume Next

ActiveSheet.Unprotect

Do

Set Y_Column = Application.InputBox("Click in the cell in the
Incumbent's Service column that corresponds with the record you wish to
delete: ", "Please Choose Correct Cell in the Incumbent's Service
column", Cells(ActiveCell.Row, 1).Address, , , , , 8)
If Err.Number < 0 Then
Call OperationCancelled(True)
Exit Sub
End If
Loop Until Y_Column.Column = 1
Call Deleted_Part_2(Y_Column(1))
ActiveWindow.SmallScroll Down:=-65000
Range("A2").Select

End Sub

Sub Deleted_Part_2(Where As Range)

Dim Msg As String
Dim Ans As Long

Where.Select

Msg = "Click on the <OK Button If You Wish To Continue In Deleting
The Current Selected Record, Or Click On the <Cancel Button To Cancel
This Operation"
Ans = MsgBox(Msg, vbOKCancel)

Application.ScreenUpdating = False

If Ans = vbOK Then

ActiveCell.Rows("1:1").EntireRow.Select

Selection.Delete Shift:=xlUp

Range("A2").Select

With Sheets("Data")
'Following line of code is like selecting the last cell
'in the column and holding the Ctrl key and press Up arrow
'It then names the cell.
.Cells(.Rows.Count, "A").End(xlUp).Name = "LastCell"

End With

Range("A2").Select

ActiveWindow.SmallScroll ToRight:=-9

Application.ScreenUpdating = True

Msg = "The Selected Record Is Now Deleted"
Ans = MsgBox(Msg, vbOKOnly)

Range("A2").Select

End If

If Ans = vbCancel Then

Msg = "The Deletion Procedure Has Now Been Cancelled"
Ans = MsgBox(Msg, vbOKOnly)
Exit Sub

End If

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True,
AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions


End Sub

Sub OperationCancelled(Optional Cancelled As Boolean)

MsgBox "You cancelled this operation."

ActiveWindow.SmallScroll ToRight:=-27

End Sub



*** Sent via Developersdex http://www.developersdex.com ***

Deletion Code - Fix please
 

This is a terrible idea - what on Earth are you trying to do Chris?

First one doesn't need to select to delete something or to clear the cell
with code.
Next, usually you can't guarantee the user can always select the desired
cell: What happens when the wrong cell is selected?
Lastly you could use a formula to flag the cells, then use some loop to
clear them, or just sort.

But if you must .... the code is fairly straightforward:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target(1, 1), [Y2:Y100]) Is Nothing Then Exit Sub
Dim c As Range, b As VbMsgBoxResult
Set c = Target(1, 1) 'to prevent multi cell selected
Set c = Union(c.Resize(1, 19), c.Offset(0, 26).Resize(1, 2))
b = MsgBox("You want to delete " & c.Address(0, 0) & "?", vbYesNo)
If b = vbYes Then c.ClearContents
End Sub

Copy this to the desired sheet code tab Chris.
I had a select in the code but that just refired the SelectEvent, and this
is easier to follow without the workaround for that.


Regards
Robert McCurdy
"Chris Hankin" wrote in message
...
Hi, could someone please help me modify my deletion code as follows:

I need the following code to be slightly modified so that when a user
selects a cell in column Y, then the contents in cells Y:AQ and AY:AZ
are deleted.

For example: if a user selects cell: Y14, then I need the cell contents
Y14:AQ14 and AY14:AZ14 to be deleted.

Sub Deleted_Part_1()


Dim Y_Column As Range

On Error Resume Next

ActiveSheet.Unprotect

Do

Set Y_Column = Application.InputBox("Click in the cell in the
Incumbent's Service column that corresponds with the record you wish to
delete: ", "Please Choose Correct Cell in the Incumbent's Service
column", Cells(ActiveCell.Row, 1).Address, , , , , 8)
If Err.Number < 0 Then
Call OperationCancelled(True)
Exit Sub
End If
Loop Until Y_Column.Column = 1
Call Deleted_Part_2(Y_Column(1))
ActiveWindow.SmallScroll Down:=-65000
Range("A2").Select

End Sub

Sub Deleted_Part_2(Where As Range)

Dim Msg As String
Dim Ans As Long

Where.Select

Msg = "Click on the <OK Button If You Wish To Continue In Deleting
The Current Selected Record, Or Click On the <Cancel Button To Cancel
This Operation"
Ans = MsgBox(Msg, vbOKCancel)

Application.ScreenUpdating = False

If Ans = vbOK Then

ActiveCell.Rows("1:1").EntireRow.Select

Selection.Delete Shift:=xlUp

Range("A2").Select

With Sheets("Data")
'Following line of code is like selecting the last cell
'in the column and holding the Ctrl key and press Up arrow
'It then names the cell.
.Cells(.Rows.Count, "A").End(xlUp).Name = "LastCell"

End With

Range("A2").Select

ActiveWindow.SmallScroll ToRight:=-9

Application.ScreenUpdating = True

Msg = "The Selected Record Is Now Deleted"
Ans = MsgBox(Msg, vbOKOnly)

Range("A2").Select

End If

If Ans = vbCancel Then

Msg = "The Deletion Procedure Has Now Been Cancelled"
Ans = MsgBox(Msg, vbOKOnly)
Exit Sub

End If

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True,
AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions


End Sub

Sub OperationCancelled(Optional Cancelled As Boolean)

MsgBox "You cancelled this operation."

ActiveWindow.SmallScroll ToRight:=-27

End Sub



*** Sent via Developersdex http://www.developersdex.com ***