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