Solved: Preventing user entering duplicate values in a cell range

[itechxxiv]

I have a series of horizontal cells (7 IN ALL) that we use to track which
phases a document status is currently in.

List of phases a document will be tracked:
A. Not started =NS
B. in-progress =IP
C. under review=UR
D. reviewed =R
E. approved =A
F. on hold =OH
G. cancelled =C

We simply enter: "0"=NO or"1"=YES (Currently enter this manually and at
times find that a document status has to many "1"'s in a particular row.)

All phases will be populated with a "0" to begin with and the user will
enter/move "1" as the document progresses through each phase.

Example Excel Table:
Cell Range for columns Headers A1:G1
Cell Range for Rows A2:A4, B2:B4, C2:C4, D2;D4, E2:E4, F2:F4, G2:G4
+---+-----+-----+-----+-----+-----+-----+-----+
|...|..A..|..B..|..C..|..D..|..E..|..F..|..G..|
+---+-----+-----+-----+-----+-----+-----+-----+
|.1.|..NS.|..IP.|..UR.|..R..|..A..|..OH.|..C..|
+---+-----+-----+-----+-----+-----+-----+-----+
|.2.|..0..|..1..|..0..|..0..|..0..|..0..|..0..|
+---+-----+-----+-----+-----+-----+-----+-----+
|.3.|..1..|..0..|..0..|..0..|..0..|..0..|..0..|
+---+-----+-----+-----+-----+-----+-----+-----+
|.4.|.[1].|..0..|..0..|..0..|.[1].|..0..|..0..|<<avoid double entries
+---+-----+-----+-----+-----+-----+-----+-----+

<<The brackets are merely to highlight the duplicates>

To avoid the user entering duplicates ?1? in a single range of cells i.e. A4:G4. I want to incorporate a feature that upon entering ?1? in the adjacent cells. all the other cells are changed back to "0" zero.



For example: if the user enters a ?1? in B4 (In-progress) and then returns later to update the document phase and enters a ?1? in C4 (Under Review) cells A4, B4, D4, E4, F4, G4 will automatically change their cell value back to ?0? zero. And so on. So, regardless where you enter a ?1? all the other cells will change to ?0? zero. Preventing a user from entering multiple ?1??s


Thanks,
itechxxiv

[mdmackillop]

Hi, and welcome to VBAX.
Very impressive formatting to get your cell structure here, but if you zip your file you can post it using Manage Attachments in the Go Advanced section.
Anyway, here's some code for you to try.
[VBA]Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rw As Long
Application.EnableEvents = False
If Not Intersect(Target, Range(Cells(2, 1), Cells(4, 7))) Is Nothing Then
Rw = Target.Row()
If Target.Value = 1 Then
Range(Cells(Rw, 1), Cells(Rw, 7)).Value = 0
Target.Value = 1
End If
End If
Application.EnableEvents = True
End Sub
[/VBA]

[Bob Phillips]

[VBA]Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rw As Long
Application.EnableEvents = False
If Not Intersect(Target, Range(Cells(2, 1), Cells(4, 7))) Is Nothing Then
Rw = Target.Row()
If Target.Value = 1 Then
Range(Cells(Rw, 1), Cells(Rw, 7)).Value = 0
Target.Value = 1
End If
End If
Application.EnableEvents = True
End Sub
[/VBA]

This can reset it back to an earlier phase. This overcomes this, and also doesn't allow a 0 to be set if it was previously a 1

[vba]
Private prev As Boolean
Const WS_RANGE As String = "A2:G4"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iPos1 As Long
Dim iPos2 As Long

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value = 1 Then
iPos1 = Application.Match(1, Cells(.Row, 1).Resize(, 7), 0)
If iPos1 > 0 Then
iPos2 = Application.Match(1, Cells(.Row, iPos1 + 1).Resize(, 7 - iPos1), 0)
If iPos2 > 0 Then
Cells(.Row, iPos1).Value = 0
End If
End If
Else
If prev Then
.Value = 1
End If
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
prev = Target.Value = 1
End If
End Sub
[/vba]

[mdmackillop]

Hi Bob,
Small point, but your code causes an error if you accidentally select more than one cell in the range.

Itech,
You might want to remove or disguise your email address in your signature to avoid it being collected by the spammers.

Regards
MD

[mdmackillop]

The following should meet XLD's concern regarding returning to a previous state, and by serendipidy, also rejects any number greater than 1. I've tagged on a separate sub to return the grid to 0 values while you try these out.
[VBA]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rw As Long
Application.EnableEvents = False
If Not Intersect(Target, Range(Cells(2, 1), Cells(4, 7))) Is Nothing Then
Rw = Target.Row()
If Application.WorksheetFunction.Sum(Range(Target, Cells(Rw, 7))) > 1 Then
Application.Undo
GoTo Exits
End If
If Target.Value = 1 Then
Range(Cells(Rw, 1), Cells(Rw, 7)).Value = 0
Target.Value = 1
End If
End If
Exits:
Application.EnableEvents = True
End Sub

Sub Reset()
Application.EnableEvents = False
Range(Cells(2, 1), Cells(4, 7)) = 0
Application.EnableEvents = True
End Sub

[/VBA]

[Zack Barresse]

Itech,
You might want to remove or disguise your email address in your signature to avoid it being collected by the spammers.

Good point. Another option would be to incorporate the email addy as part of the image in the sig, then surround the img with url tags, thus hyperlinking the email addy anyway.

[mdmackillop]

Is this solved?

[itechxxiv]

Yes, thank you. Sorry been so busy before the office closes before the holidays. I am part of a very large SAP implementation.

[mdmackillop]

SAP?

[Bob Phillips]

SAP?

Do you live on the edge of beyond?

http://www.sap.com/index.epx