This is because the technique uses the fact that a range is selected while entering data to help keep within the range you want. But, just as you would delete a range by selecting it then pressing the delete key, you already know that it deletes the whole selected range, so this macro has a flaw.
Try the following instead. Copy it into the sheet's code module with nothing else above it, making sure you don't have any subs with identical names.
It switches into and out of tab order mode by right-clicking a cell, either in the range or out of it. If you click in the data entry range it allows data entry from the cell that was right-clicked.
When right-clicking outside the data entry range, you will have to right-click twice to make it stick.
Note also the comments within the code.
The code which dobtless Yahoo groups will do its best to foul up (the first three lines have to be above any subs in the code module):
***********************************
Dim lastcell As String
Dim rg As Range
Dim tabOrderMode As Boolean
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'Switches tabOrderMode according to where right clicking takes place.
Cancel = True 'can comment this line out if you want to retain right-click menu.
If Intersect(rg, Target) Is Nothing Then
tabOrderMode = False
Else
tabOrderMode = True
lastcell = Target.Address(0, 0) 'this allows data entry to start from the cell which was right-clicked.
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Note the next line has the first address repeated at the end, to allow looping around the range:
TabOrder = Array("h8", "h9", "h10", "h11", "h13", "l11", "l12", "h17", "k17", _
"h18", "k18", "k21", "k22", "n26", "n27", "n31", "k37", "e82", "f82", "h82", _
"j82", "e83", "f83", "h83", "j83", "e84", "f84", "h84", "j84", "e85", "f85", _
"h85", "j85", "e86", "f86", "h86", "j86", "e87", "f87", "h87", "j87", "e88", _
"f88", "h88", "j88", "e89", "f89", "h89", "j89", "h8")
Set rg = Range(Join(TabOrder, ",")) 'less cumbersome than a loop
'The above 2 lines are here to establish global range variable rg. They could be elsewhere (Sheet_ACtivation event?)
If tabOrderMode Then
x = Application.Match(lastcell, TabOrder, 0)
If Not IsError(x) Then
Range(TabOrder(x)).Select
lastcell = TabOrder(x)
Else
Range(TabOrder(0)).Select
lastcell = TabOrder(0)
End If
End If
End Sub
*****************************************
--- In ExcelVBA@yahoogroups.com, railroads@... wrote:
>
> Hi
>
> When using the code below, if you make an error in a entry and hit the delete button, all cells get deleted. Somewhat frustrating. The code works well, except for the delting all cells when hitting the delete button. Is there a code to add to stop this happening ?
>
> Thanks
>
> Charlie Harris
>
> ****
>
> Private Sub Worksheet_SelectionChange(ByVal Target As Range)
> 'Establishes tab order for data entry. Hit Enter or Tab keys to jump to the next cell.
>
> Dim TabOrder As Variant, X As Variant
> Dim addr As String
> Dim rg As Range, targ As Range
> If TabOrderFlag = True Then Exit Sub
>
> TabOrder = Array("h8", "h9", "h10", "h11", "h13", "l11", "l12", "h17", "k17", "h18", "k18", "k21", "k22", "n26", "n27", "n31", _
> "k37", "e82", "f82", "h82", "j82", "e83", "f83", "h83", "j83", "e84", "f84", "h84", "j84", "e85", "f85", "h85", _
> "j85", "e86", "f86", "h86", "j86", "e87", "f87", "h87", "j87", "e88", "f88", "h88", "j88", "e89", "f89", _
> "h89", "j89")
>
> 'List your cell addresses in desired tab order here
> For Each X In TabOrder
> If rg Is Nothing Then
> Set rg = Range(X)
> Else
> Set rg = Union(rg, Range(X))
> End If
> Next
>
> Set targ = Intersect(rg, Target)
> rg.Select
> If targ Is Nothing Then
> addr = Target.Cells(1, 1).Address(ColumnAbsolute:=False, RowAbsolute:=False)
> X = Application.Match(addr, TabOrder, 0)
> If IsError(X) Then Range(TabOrder(LBound(TabOrder))).Activate
> Else
> targ.Activate
> End If
>
> End Sub
>
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
Tidak ada komentar:
Posting Komentar