Consulting

Results 1 to 4 of 4

Thread: Solved: Prevent users from entering "Essential Position" in more than one worksheet

  1. #1
    VBAX Tutor
    Joined
    Aug 2007
    Posts
    294
    Location

    Solved: Prevent users from entering "Essential Position" in more than one worksheet

    See attached workbook
    Hi

    Need to stop users entering the word "Essential Position" more than once in cell c7 worksheet(s) scenario 1,scenario 2, scenario 3, scenario 4, scenario 5..

    So if the user input the word "Essential Position" into scenario 1, then they cannot enter it again into none of the other scenario(s)....i.e. msg box..."You have all ready assigned essential position to scenario X"....

    I have added the following VBA code to a new module "Essential"

    [VBA]Function CheckForDups(ByRef vtarget As String) As Boolean
    Dim vCellValue(5) As String '---- 5 = number of sheets to check
    Dim j As Long
    Dim j2 As Long
    Dim vDupFound As Boolean
    '----------------------- replace sheetx with the names of your sheets -----------
    vCellValue(1) = Worksheets("Scenario1").Range(vtarget).value
    vCellValue(2) = Worksheets("Scenario2").Range(vtarget).value
    vCellValue(3) = Worksheets("Scenario3").Range(vtarget).value
    vCellValue(4) = Worksheets("Scenario4").Range(vtarget).value
    vCellValue(5) = Worksheets("Scenario5").Range(vtarget).value
    For j = 1 To 2 '--- number of checked sheets - 1 --------
    If vCellValue(j) <> "" Then

    For j2 = j + 1 To 5 ' --- 5 = number of sheets to check ----
    If vCellValue(j2) <> "" Then
    If vCellValue(j) = vCellValue(j2) Then
    vDupFound = True
    Exit For
    End If
    End If
    Next j2
    End If
    If vDupFound = True Then
    Exit For
    End If
    Next j
    If vDupFound = True Then
    CheckForDups = True
    End If
    End Function


    and added the following code to each of the scenario worksheet(s):

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim vtarget As String
    vtarget = Target.Address
    If CheckForDups(vtarget) = True Then
    MsgBox "You have all ready assigned essential position - please check"
    End If
    End Sub[/VBA]

    Edited by Aussiebear: Pete, if you want to post sections of code to the forum, would you please use the VBA button to wrap your code, it makes the code so much easier to read.

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    You have got two worksheet_SelectChange events on multiple sheets, one has compile errors, and the text ius in A7 not C7.

    Might be best to tidy it up before posting, else we will lose the will to live.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Tutor
    Joined
    Aug 2007
    Posts
    294
    Location
    ok.........i'll be back...........

  4. #4
    VBAX Tutor
    Joined
    Aug 2007
    Posts
    294
    Location
    Function CheckForDups(ByRef vtarget As String) As BooleanDim vCellValue(5) As String '---- 5 = number of sheets to checkDim j As LongDim j2 As LongDim vDupFound As Boolean '----------------------- replace sheetx with the names of your sheets -----------vCellValue(1) = Worksheets("Scenario1").Range(vtarget).valuevCellValue(2) = Worksheets("Scenario2").Range(vtarget).valuevCellValue(3) = Worksheets("Scenario3").Range(vtarget).valuevCellValue(4) = Worksheets("Scenario4").Range(vtarget).valuevCellValue(5) = Worksheets("Scenario5").Range(vtarget).value For j = 1 To 4 '--- number of checked sheets - 1 -------- If vCellValue(j) <> "" Then For j2 = j + 1 To 5 ' --- 5 = number of sheets to check ---- If vCellValue(j2) <> "" Then If vCellValue(j) = vCellValue(j2) Then vDupFound = True Exit For End If End If Next j2 End If If vDupFound = True Then Exit For End IfNext jIf vDupFound = True Then CheckForDups = TrueEnd IfEnd Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •