Conditional Auto Numbering

[vilas desai]

Dear Sirs,

I am now finalised on the Auto-numbering which I earlier struggled to explain.
refer Sheet : MasterList
Goal1: I want to auto-number col L named JB Terminal
Conditions: Check for Col K. $K5 takes values as a result of concatenation of answers to two questions in the Msg box.
Q1: Enter Junction Box Type: JB_A1 / JB_A2 / JB_B1 / JB_B2
Q2: Enter Junction Box No: Any numerical value, like 2, 32, 741 etc (max 999)
So, $K5 = 1JB_A1 or 32JB_A1 or 76JB_A2 or 872JB_B2 etc.

CONDITION 1:
If the value found in $K5 is new (not found earlier in the col), then $L5 = 1. for ex: If
K5 = 1JB_A1 then L5 =1
K45 = 2JB_A1 then L45 =1
K111 = 3JB_A1 then L111=1 (Note that 3JB_A1 <> 1JB_A1)
K137 = 1JB_A2 then L137=1 (Note that 1JB_A1 <> 1JB_A2)
K147 = 3JB_A2 then L147=1

If the value found in $K6 is new, $K6= $I5 + $K5 for example, let us consider the above values again as below:
(Note that $I5 will be either 2 or 3 or 4 selected by DD list, In all examples below I have considered $I5 =2)

K5 = 1JB_A1 then L5 =1
K6 = 1JB_A1 then L6 =3
K7 = 1JB_A1 then L7 =5
K8 = 1JB_A1 then L8 =7
K9 = 1JB_A1 then L9 =9
K10 = 1JB_A1 then L10 =11
K11 = 1JB_A1 then L11 =13 etc

similarly,
K45 = 2JB_A1 then L45 =1
K46= 2JB_A1 then L46 =3
k47 = 2JB_A1 then L47 =5
k48= 2JB_A1 then L48 =7

and so forth.

CONDITION 2: for maximum value in $L6
The idea is to restrict the added value in L in accordance to which type of Junction Box is used
For type JB_A1, maximum value of addition is 18
For type JB_A2, maximum value of addition is 30
For type JB_B1, maximum value of addition is 24
For type JB_B2, maximum value of addition is 40

Procedure: If the count value exceed 18, and if the type of Junction is 'xJB_A1' (regardless of any value of x (x=enter junction box number) then
SUB1: MSG Box Max Terminals for the selected type of Junction Box is exceeding it's Limits. Please select a different type of Junction Box or Please select a new number of junction box. On clicking OK, the active cellwill be the cell where the new type / number is selected. ie, cell K.
If the count value exceed 18, and if the type of Junction is NOT 'xJB_A1' then continue the addition till the count exceeds 30. Again,
If the count value exceed 30, and if the type of Junction is 'xJB_A2' (regardless of any value of x (x=enter junction box number) then Go to SUB1.
continue this till addition exceeds 40.

Goal 2: Please try only if this makes sense. I would like to have a Pivot Table in accordance to the attached workbook - wsh JB_Distr.

Thanks in advance and best regards

If you are providing a macro then please refer to the existing wsh "MasterList: code provided below:

Code: Select all

Option Explicit

Dim mbNoEvent As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vPrevValue As Variant
    Dim vCurValue As Variant
    Dim lngIndex As Long
    Dim strSource As String
    Dim strDestination As String
    Dim strList As String
    Dim wshSource As Worksheet
    Dim wshDestination As Worksheet
    Dim wshList As Worksheet
    Dim rngSource As Range
    Dim rngDestination As Range
    Dim lngRowCount As Long
    Dim lngCount As Long
    Dim wshDV As Worksheet
    Dim strPW As String
    Dim varUser As Variant

    Dim current_row As Long
    Dim column_numbers As Variant
    Dim col_counter As Long
    Static Exempt_Range As Range
    
    If mbNoEvent Then Exit Sub
    
    If Target.Address = ActiveSheet.ListObjects(1).HeaderRowRange.Offset(ActiveSheet.ListObjects(1).ListRows.Count).Address _
        And Target.Rows.Count = 1 Then
        current_row = Target.Row
        column_numbers = Split("G,I,J,L,M,X,Y,Z", ",")
        Set Exempt_Range = Nothing
        For col_counter = LBound(column_numbers) To UBound(column_numbers)
            If Exempt_Range Is Nothing Then
               Set Exempt_Range = Range(column_numbers(col_counter) & current_row)
            Else
               Set Exempt_Range = Union(Exempt_Range, Range(column_numbers(col_counter) & current_row))
            End If
        Next
        Exit Sub
    End If
    
    If Target.Address = Target.EntireRow.Address Then Exit Sub
    If Exempt_Range Is Nothing Then
       current_row = Target.Row
       column_numbers = Split("G,I,J,L,M,X,Y,Z", ",")
       Set Exempt_Range = Nothing
       For col_counter = LBound(column_numbers) To UBound(column_numbers)
           If Exempt_Range Is Nothing Then
              Set Exempt_Range = Range(column_numbers(col_counter) & current_row)
           Else
              Set Exempt_Range = Union(Exempt_Range, Range(column_numbers(col_counter) & current_row))
           End If
       Next
    End If
    
    If Not (Application.Intersect(Target, Exempt_Range) Is Nothing) Then Exit Sub

    If Target.Count > 1 Then
        Application.EnableEvents = False
        Application.Undo
        MsgBox "Multiple cell changes are Not allowed.", vbExclamation
        Application.EnableEvents = True
        Exit Sub
    End If

    On Error GoTo ErrHandler
    mbNoEvent = True

    ' Get previous and current value
    vCurValue = Target.Value
    Application.EnableEvents = False
    Application.Undo
    vPrevValue = Target.Value
    If vPrevValue = "" Then
        Target.Value = vCurValue
    ElseIf vPrevValue = vCurValue Then
        ' Ignore
    Else
        strPW = InputBox("Enter your password")
        Set wshDV = Worksheets("DV")
        varUser = Application.VLookup(strPW, wshDV.Range("PasswordList"), 2, False)
        If IsError(varUser) Then
            MsgBox "Password invalid. Change not allowed!", vbCritical
            GoTo ExitHandler
        End If
        Target.Value = vCurValue
        Call SetHistory(varUser, vPrevValue, vCurValue, Target.Address)
    End If
    Application.EnableEvents = True

    If Intersect(Target, Me.Range("D:D")) Is Nothing Then
        If Not Intersect(Target, Me.Range("E:E")) Is Nothing Then
            Call CheckCol_E(Intersect(Target, Me.Range("E:E")).Offset(0, -1))
        End If
        GoTo ExitHandler
    End If

    Set wshList = Worksheets("List")
    If vCurValue = vPrevValue Then
        GoTo ExitHandler
    End If
    If vPrevValue <> "" Then
        lngCount = Application.WorksheetFunction.CountIf(Me.Range("D5:" & Target.Address), vPrevValue)
        ' Get info about previous source range
        lngIndex = Application.WorksheetFunction.Match(vPrevValue, wshList.Range("A:A"), 0)
        strSource = wshList.Range("B" & lngIndex)
        Set wshSource = Worksheets(strSource)
        strSource = wshList.Range("C" & lngIndex)
        Set rngSource = wshSource.Range(strSource)
        lngRowCount = rngSource.Rows.Count
        ' Get info about previous destination
        strDestination = wshList.Range("D" & lngIndex)
        Set wshDestination = Worksheets(strDestination)
        strDestination = wshList.Range("E" & lngIndex)
        Set rngDestination = wshDestination.Range(strDestination).Offset(lngCount * lngRowCount, 0)
        Set rngDestination = rngDestination.Resize(rngSource.Rows.Count, rngSource.Columns.Count)
        ' Delete
        rngDestination.Delete Shift:=xlShiftUp
    End If
    If vCurValue <> "" Then
        lngCount = Application.WorksheetFunction.CountIf(Me.Range("D5:" & Target.Address), vCurValue) - 1
        ' Get info about current source range
        lngIndex = Application.WorksheetFunction.Match(vCurValue, wshList.Range("A:A"), 0)
        strSource = wshList.Range("B" & lngIndex)
        Set wshSource = Worksheets(strSource)
        strSource = wshList.Range("C" & lngIndex)
        Set rngSource = wshSource.Range(strSource)
        lngRowCount = rngSource.Rows.Count
        ' Get info about current destination
        strDestination = wshList.Range("D" & lngIndex)
        Set wshDestination = Worksheets(strDestination)
        strDestination = wshList.Range("E" & lngIndex)
        Set rngDestination = wshDestination.Range(strDestination).Offset(lngCount * lngRowCount, 0)
        Set rngDestination = rngDestination.Resize(rngSource.Rows.Count, rngSource.Columns.Count)
        strDestination = rngDestination.Address
        rngDestination.Insert Shift:=xlDown
        Set rngDestination = rngDestination.Worksheet.Range(strDestination)
        ' Copy
        rngSource.Copy Destination:=rngDestination
        rngSource.Copy
        rngDestination.PasteSpecial Paste:=xlPasteColumnWidths
        Call UpdateValues(Target, rngDestination, wshList.Range("F" & lngIndex))
        Call CheckCol_E(Target)
    Else
        Target.Offset(0, 1) = ""
    End If

ExitHandler:
    mbNoEvent = False
    Application.EnableEvents = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Private Sub UpdateValues(ByVal MasterListColD As Range, ByVal rngDestination As Range, ByVal CpyRowOffsetadd As Long)
    ' rngDestination(CpyRowOffsetadd, 1) = "=if(" & _
    MasterListColD.Worksheet.Name & "!" & MasterListColD.Offset(0, 3).Address & "=""""," _
    & MasterListColD.Worksheet.Name & "!" & MasterListColD.Offset(0, 2).Address & "," & _
    MasterListColD.Worksheet.Name & "!" & MasterListColD.Offset(0, 2).Address & "&""-""&" & _
    MasterListColD.Worksheet.Name & "!" & MasterListColD.Offset(0, 3).Address & ")"

    'P&ID Ref
    rngDestination(CpyRowOffsetadd + 1, 6) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, -3).Address

    'Service Area
    rngDestination(CpyRowOffsetadd + 2, 6) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, -2).Address

    'Service Equipment
    rngDestination(CpyRowOffsetadd + 3, 6) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, -1).Address

    'Device
    rngDestination(CpyRowOffsetadd + 4, 6) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 0).Address

    'Device Function
    rngDestination(CpyRowOffsetadd + 5, 6) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 1).Address

    'Measurement
    rngDestination(CpyRowOffsetadd + 6, 6) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 2).Address

    'Loop Number
    rngDestination(CpyRowOffsetadd + 1, 20) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 4).Address

    'Jn Box ID
    rngDestination(CpyRowOffsetadd + 2, 20) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 7).Address

    'Device tag
    rngDestination(CpyRowOffsetadd + 4, 20) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 6).Address

    'Cable tag
    rngDestination(CpyRowOffsetadd + 5, 20) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 8).Address

    'IO tag
    rngDestination(CpyRowOffsetadd + 6, 20) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 20).Address

    'M.R ID
    rngDestination(CpyRowOffsetadd + 3, 20) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 9).Address

'------------------------------------------------------------------------------------
    'PLC Panel ID
    rngDestination(CpyRowOffsetadd + 1, 30) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 12).Address

    'PLC / DCS ID
    rngDestination(CpyRowOffsetadd + 2, 28) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 13).Address

    'PLC RAck Number
    rngDestination(CpyRowOffsetadd + 3, 28) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 16).Address

    'Slot Number
    rngDestination(CpyRowOffsetadd + 3, 32) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 17).Address

    'Channel Number
    rngDestination(CpyRowOffsetadd + 4, 28) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 18).Address

    'IO Type
    rngDestination(CpyRowOffsetadd + 5, 28) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 19).Address

    'No. of Wires
    rngDestination(CpyRowOffsetadd + 6, 29) = "=" & MasterListColD.Worksheet.Name _
        & "!" & MasterListColD.Offset(0, 5).Address

    Application.CutCopyMode = False
End Sub


Private Sub CheckCol_E(ByVal MasterListColD As Range)
    Dim ColorMark As Boolean
    Dim MasterListColE As Range
    Dim cel As Range
    Set MasterListColE = MasterListColD.Offset(0, 1)
    ColorMark = True
    If MasterListColD.Value = "" Or MasterListColE.Value = "" Then
        With MasterListColE.Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 3
        End With
    Exit Sub
    End If

    For Each cel In Application.Range(MasterListColD.Value)
        If cel.Value = MasterListColE.Value Then
            ColorMark = False
            Exit For
        End If
    Next

    If ColorMark Then
        With MasterListColE.Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 3
        End With
    Else
        MasterListColE.Borders.LineStyle = xlNone
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Range("K5:K" & Rows.Count & ",N5:N" & Rows.Count & _
            ",P5:P" & Rows.Count), Target) Is Nothing Then
        frmSelect.Show
    End If
End Sub

[HansV]

Why do you want values 1, 3, 5, ... in Condition 1? In Condition 2 you refer to even values such as 18 and 30...

[vilas desai]

Dear Hans,

Dear Hans,
I am not too sure if I understood your question correctly but I am trying to explain based on my understanding.

Why do you want values 1, 3, 5, ... in Condition 1?
Ans 1: Because the values that col L can take is progressive in steps of Col I as long as the values do not exceed the set limit.
If L5 = 1 and I5=2 then the L6 = L5 + I5,
But if I=3 or I = 4 then L6 becomes an even number

In Condition 2 you refer to even values such as 18 and 30..
Ans: I am trying to compare Current odd value with the accumulated even value
and current even value with the accumulated even value.
But I think it would not really matter (odd or even) as long as the comparison is made and exceeding values are not permitted.

Please advise me if my understanding of your question is in line.
Best regards
Vilas Desai

[HansV]

Ah - I hadn't understood that L6 = L5 + I5.

I'll see if I can come up with something later today - perhaps someone else will reply first.

[HansV]

I thought I had already written such code (or something very similar) some weeks ago?

[vilas desai]

Yes Hans, that is why I began this request by saying that "I am now finalised on the Auto-numbering which I earlier struggled to explain. " Somehow the earlier problem statement did not make any sense to write the code or my explanation of problem definition could not be correct. I then modified the Col for No of Wires and made it less complex. ( I removed all zeros). I also ended up the earlier request apologizing that my request was rather absurd and that I would come up with a more meaningful request next time. I tried to make this current request as clear as possible. (though I must admit I missed out on explaining L6 = I5 + L5
Thanks and best regards
Vilas Desai

[vilas desai]

This is the link to the last correspondence on this subject

http://www.eileenslounge.com/viewtopic.php?f=27&t=17407" onclick="window.open(this.href);return false;

[HansV]

Have you tried incorporating the code that I wrote there (in Post=134281)?

[vilas desai]

Yes, I did, but what it did was it checked the type of Junction Box that was used. For example if the concatenation of (Jn Box No & JN Box type) was 1JB_A1 the code checked for JB_A1 and gave a message that Future JB_A1 could not be used after the no of terminals exceeded the set value, where as the requirement is if 1JB_A1 has exceeded the set value the go for another JB_A1, for ex, go for 2JB_A1.

[HansV]

I fear it's still too complicated. Better forget about this. (Or hire a professional programmer in India)

[vilas desai]

No Problems, Hans. Thank you. I don't know if I could make it more simpler.

Best regards
Vilas Desai

[vilas desai]

Dear Hans,
I could get some help on this topic and I am very very close to where we set our goal. The formula below placed in L5 does the trick:
=MIN(IF(COUNTIF($K$4:$K10,$K10)=1, 1, LOOKUP(2, 1/($K$4:$K9=$K10), ($L$4:$L9+$I$4:$I9))), CHOOSE(MATCH(RIGHT(K10,2), {"A1","A2","B1","B2"}, 0), 18, 30, 24, 40))
Please also see the attached file with the results.
You would notice that once the max value is reached for a prticular type of JB (as shown in the file, it is 1JB_B1 having a max value of 24) the future calculations stop at the maximum value.
Now what I would like to have, is on the first instance of reaching the maximum value, the cells in Col K and Col L format to a diff color (Red) and also instruct the user by a message box to change the number or type of the JB and to repeat this message as long as the new selections are not made. On seeing the new selections the cells turn back to no color. This may be by a code or by extension of the current formula as above.
Since the file size is large I am sending it to you by email.
Thanking you,
Best regards
Vilas Desai

[vilas desai]

Dear Hans

I could not send the detailed file through email too, it was returned back. So I am sending only the sample file with the formula. If you need the worksheet macro, the file is availabe with you and again, for your ready ref the pw is vdesai!

Best regards

[HansV]

I'm sorry, I don't have your workbooks any more, so I can't do anything with the workbook that you attached.

[HansV]

Dear Vilas,

I have sent you a modified version of your workbook.

I have tried to incorporate the code from an earlier thread in the code for the frmSelect userform. If you click on a cell in column K, and select a box type that is at or over the limit, you'll get a warning.
I'm not sure I did it correctly, so please test carefully.

By removing unused rows and columns, the workbook has become less than 2 MB in size.