Any suggestions....?? Most appreciated.


Code in Sheet1

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim VRange As Range, cell As Range
Dim Msg As String
Dim ValidateCode As Variant
Set VRange = Range("A1:F65536")
For Each cell In Target
If Union(cell, VRange).Address = VRange.Address Then
ValidateCode = EntryIsValid(cell.Address([False], [False]))
MsgBox "Dept: " & ValidateCode(1) & vbCrLf & _
"Loc: " & ValidateCode(2) & vbCrLf & _
"Fn: " & ValidateCode(3) & vbCrLf & _
"Acct: " & ValidateCode(4) & vbCrLf & _
"Fleet: " & ValidateCode(5) & vbCrLf & _
"Bldg: " & ValidateCode(6)
End If
Next cell
End Sub

Code in Module

Private Function EntryIsValid(celladdress) As Variant
Dim Dept As Variant
Dim Loc As Variant
Dim Fn As Variant
Dim Acct As Variant
Dim Fleet As Variant
Dim Bldg As Variant
Dim CellCase As String

CellCase = Left(CStr(celladdress), 1)
Select Case CellCase
Case "A"
Dept = Range(celladdress).Offset(0, 0)
Loc = Range(celladdress).Offset(0, 1)
Fn = Range(celladdress).Offset(0, 2)
Acct = Range(celladdress).Offset(0, 3)
Fleet = Range(celladdress).Offset(0, 4)
Bldg = Range(celladdress).Offset(0, 5)
Case "B"
Dept = Range(celladdress).Offset(0, -1)
Loc = Range(celladdress).Offset(0, 0)
Fn = Range(celladdress).Offset(0, 1)
Acct = Range(celladdress).Offset(0, 2)
Fleet = Range(celladdress).Offset(0, 3)
Bldg = Range(celladdress).Offset(0, 4)
Case "C"
Dept = Range(celladdress).Offset(0, -2)
Loc = Range(celladdress).Offset(0, -1)
Fn = Range(celladdress).Offset(0, 0)
Acct = Range(celladdress).Offset(0, 1)
Fleet = Range(celladdress).Offset(0, 2)
Bldg = Range(celladdress).Offset(0, 3)
Case "D"
Dept = Range(celladdress).Offset(0, -3)
Loc = Range(celladdress).Offset(0, -2)
Fn = Range(celladdress).Offset(0, -1)
Acct = Range(celladdress).Offset(0, 0)
Fleet = Range(celladdress).Offset(0, 1)
Bldg = Range(celladdress).Offset(0, 2)
Case "E"
Dept = Range(celladdress).Offset(0, -4)
Loc = Range(celladdress).Offset(0, -3)
Fn = Range(celladdress).Offset(0, -2)
Acct = Range(celladdress).Offset(0, -1)
Fleet = Range(celladdress).Offset(0, 0)
Bldg = Range(celladdress).Offset(0, 1)
Case "F"
Dept = Range(celladdress).Offset(0, -5)
Loc = Range(celladdress).Offset(0, -4)
Fn = Range(celladdress).Offset(0, -3)
Acct = Range(celladdress).Offset(0, -2)
Fleet = Range(celladdress).Offset(0, -1)
Bldg = Range(celladdress).Offset(0, 0)
Case Else
End Select

EntryIsValid(1) = Dept
EntryIsValid(2) = Loc
EntryIsValid(3) = Fn
EntryIsValid(4) = Acct
EntryIsValid(5) = Fleet
EntryIsValid(6) = Bldg

End Function