Israel Anthony Lopez
asked on
Assigning a unique ID from a pool of unique IDs to a product.
I want to assign a unique number ID to a product based on the type of product it is.
Product Type Product Type Number Unique Identifier Range
General 972 19216872100 through 19216872150
Bakery 1274 19210240100 through 19210240150
Produce 12373 19211246100 through 19211246150
Meats Due to the expense of meats they need to be tracked on a finite scale
Problem 1: The record has already been tagged with the appropriate product type code by the store manager. Each product type should be assigned a unique ID number from a list of unique ID numbers and no two of the same products can use the same unique ID number in a product type. The list of unique ID numbers is different for each product type. Of course, this has been scaled down due to the fact that there can be thousands of products in a grocery store.
Problem 2: This problem is similar in form and function to Problem 1 just re-used for a smaller scale. Each meat type is coded for a particular meat type. This is also coded from a fixed range of unique IDs identified by the store manager. Again, no two types of packages of meat shall have the same unique ID and they must from the proper Sub Product Type. This is important since this will track the meats. Of course, this has been scaled down due to the fact that there can be thousands of packages of meat.
Product Type Sub Product Type Unique Identifier Range
Meat Deli 1 - Chicken 192128253-1 through 192128253-50
Meat Deli 2 - Beef 192128253-51 through 192128253-100
Meat Deli 3 - Pork 192128253-101 through 192128253-150
Meat Deli 4 - Lamb 192128253-151 through 192128253-200
Meat Deli 5 - Fish 192128253-201 through 192128253-250
Product Type Product Type Number Unique Identifier Range
General 972 19216872100 through 19216872150
Bakery 1274 19210240100 through 19210240150
Produce 12373 19211246100 through 19211246150
Meats Due to the expense of meats they need to be tracked on a finite scale
Problem 1: The record has already been tagged with the appropriate product type code by the store manager. Each product type should be assigned a unique ID number from a list of unique ID numbers and no two of the same products can use the same unique ID number in a product type. The list of unique ID numbers is different for each product type. Of course, this has been scaled down due to the fact that there can be thousands of products in a grocery store.
Problem 2: This problem is similar in form and function to Problem 1 just re-used for a smaller scale. Each meat type is coded for a particular meat type. This is also coded from a fixed range of unique IDs identified by the store manager. Again, no two types of packages of meat shall have the same unique ID and they must from the proper Sub Product Type. This is important since this will track the meats. Of course, this has been scaled down due to the fact that there can be thousands of packages of meat.
Product Type Sub Product Type Unique Identifier Range
Meat Deli 1 - Chicken 192128253-1 through 192128253-50
Meat Deli 2 - Beef 192128253-51 through 192128253-100
Meat Deli 3 - Pork 192128253-101 through 192128253-150
Meat Deli 4 - Lamb 192128253-151 through 192128253-200
Meat Deli 5 - Fish 192128253-201 through 192128253-250
ASKER
Yes, but the Unique Identifier is assigned based on the Product Type Number. Think of the Unique Identifier as a serial number that is always unique to this product type. The only thing you need to do is to assign a Unique Identifier and ensure that a duplicate has not been issued.
Dataset
Product Type Product Type # Unique Identifier
General 972 19216872100
General 972 19216872101
General 972 19216872102
General 972 19216872103
General 972 19216872104
... ... ...
General 972 19216872150
In the real world example we have roughly 16 different Product Types and Product Type Numbers. I just simplified it for this example.
Dataset
Product Type Product Type # Unique Identifier
General 972 19216872100
General 972 19216872101
General 972 19216872102
General 972 19216872103
General 972 19216872104
... ... ...
General 972 19216872150
In the real world example we have roughly 16 different Product Types and Product Type Numbers. I just simplified it for this example.
OK... Potentially "Unique" then :)
...Still waiting for a question, or why you have created this thread, though.
...Still waiting for a question, or why you have created this thread, though.
ASKER
I am sorry if I am not intelligent enough to say it any other way than "Assigning a unique ID from a pool of unique IDs to a product". I want you to assign a unique number from a pool of numbers for right column in both examples. I unable to explain it in any other way. Sorry.
It is not a matter of intelligence; it's a matter of intent for assistance with a problem you are experiencing.
If that statement relates to what would you like the "Experts" to do for you, have you tried to do this task yourself & reached a point were you are not able to continue, or are you just expecting somebody to take over your project for you?
Either way, a sample workbook with the layout of your data & information regarding the presentation of the outcome within the workbook may help others engage with your thread.
If that statement relates to what would you like the "Experts" to do for you, have you tried to do this task yourself & reached a point were you are not able to continue, or are you just expecting somebody to take over your project for you?
Either way, a sample workbook with the layout of your data & information regarding the presentation of the outcome within the workbook may help others engage with your thread.
ASKER
No, I have tried for days to work on the problem. I have done Excel spreadsheets that look for duplicate IPs in other sheets and returns a 0 for none, 1 for confirmation, 2 for duplicate, etc. I also have done spreadsheets that go lookup whether a website is valid or not and returns a value. Wait a minute...that might help. While I look that up again, here is the spreadsheet that you requested.
I have done many complex spreadsheets but I have never completed a VLOOKUP with a Match
My_CopyITS-Device-deployment-Planni.xlsx
I have done many complex spreadsheets but I have never completed a VLOOKUP with a Match
My_CopyITS-Device-deployment-Planni.xlsx
ASKER
For more context to the problem here is my original posting.
https://www.experts-exchange.com/questions/28737521/Assign-an-IP-address-automatically-based-on-range-with-no-duplicate-assignments.html
https://www.experts-exchange.com/questions/28737521/Assign-an-IP-address-automatically-based-on-range-with-no-duplicate-assignments.html
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I have nothing against VBA and have used VBA in other Excel spreadsheets.
You are the Excel Master and all should worship at your feet. :) byundt, I appreciate this and this will help the common good since we deploy so much infrastructure in the field that provides traveler information to the public (CCTV cameras, vehicle detection to detect congestion, roadway signs to inform the public). This helps people get where they want to get in a timely manner and you just made the very first step of getting that infrastructure available much easier.
I am sure you read the "IP Assignment" question as well.
https://www.experts-exchange.com/questions/28737521/Assign-an-IP-address-automatically-based-on-range-with-no-duplicate-assignments.html
byundt, let me know if you need a recommendation or endorsement on LinkedIn.
You are the Excel Master and all should worship at your feet. :) byundt, I appreciate this and this will help the common good since we deploy so much infrastructure in the field that provides traveler information to the public (CCTV cameras, vehicle detection to detect congestion, roadway signs to inform the public). This helps people get where they want to get in a timely manner and you just made the very first step of getting that infrastructure available much easier.
I am sure you read the "IP Assignment" question as well.
https://www.experts-exchange.com/questions/28737521/Assign-an-IP-address-automatically-based-on-range-with-no-duplicate-assignments.html
byundt, let me know if you need a recommendation or endorsement on LinkedIn.
ASKER
The solution was stellar and exceeded my expectations. Not only does the solution uniquely assign an IP address, all you have to do to assign an IP is click in the field. Great work!
Israel Anthony Lopez,
Please continue to post in this thread if you have problems implementing the suggested approach in your real workbook.
The posted code made a number of assumptions in the effort to start a fruitful discussion. It is not robust enough to hand out to the masses. Among other things:
Please continue to post in this thread if you have problems implementing the suggested approach in your real workbook.
The posted code made a number of assumptions in the effort to start a fruitful discussion. It is not robust enough to hand out to the masses. Among other things:
The code assumes that the list on the Master worksheet contains no gaps. All the IP addresses for a given type are in one continuous block, sorted by subtype.
There are no blank rows in the table on the Master worksheet. The code uses the MATCH and COUNTIFS function to determine where the next available IP is located, and blank rows will cause an incorrect answer to be given.
If all available IP addresses for a given type and subtype have been assigned, the code gives you one anyway. Error checking needs to be added.
I added a test for whether all available IPs (in a given type and subtype) have been used up. If so, NextIP returns a warning message.
I also added sub SortMasterIPs to sort the IPs on the Master worksheet by type, subtype, in use and IP. This eliminates the problem with blank rows and allows you to reuse an IP if you deallocate it (by manually clearing the X on the Master worksheet). This sub is called by a Worksheet_Deactivate sub on the Master worksheet, so it will run automatically whenever you switch away from the Master worksheet.
The combination of these tweaks addresses all three issues identified in my previous Comment.
I also added sub SortMasterIPs to sort the IPs on the Master worksheet by type, subtype, in use and IP. This eliminates the problem with blank rows and allows you to reuse an IP if you deallocate it (by manually clearing the X on the Master worksheet). This sub is called by a Worksheet_Deactivate sub on the Master worksheet, so it will run automatically whenever you switch away from the Master worksheet.
The combination of these tweaks addresses all three issues identified in my previous Comment.
'This sub must go in code pane of Master worksheet. It won't work at all if installed anywhere else!
Private Sub Worksheet_Deactivate()
SortMasterIPs
End Sub
'This code goes in a regular module sheet
Function NextIP(sType As String, sSubtype As String) As Variant
'Returns the next available IP address for a given type and subtype
Dim rgMaster As Range
Dim vType As Variant, vSubtype As Variant
Dim nAssigned As Long, nRows As Long, nAvailable As Long
Set rgMaster = Worksheets("Master").Range("A1").CurrentRegion
nRows = rgMaster.Rows.Count
vType = Application.Match(sType, rgMaster.Columns(1), 0)
If IsError(vType) Then
NextIP = "No type match"
Exit Function
End If
vSubtype = 0
If sSubtype <> "" Then
vSubtype = Application.Match(sSubtype, Range(rgMaster.Cells(vType, 2), rgMaster.Cells(nRows, 2)), 0)
If IsError(vSubtype) Then
NextIP = "No subtype match"
Exit Function
Else
vSubtype = vSubtype - 1
End If
End If
nAvailable = Application.CountIfs(rgMaster.Columns(1), sType, rgMaster.Columns(2), sSubtype)
nAssigned = Application.CountIfs(rgMaster.Columns(1), sType, rgMaster.Columns(2), sSubtype, rgMaster.Columns(4), "<>")
NextIP = IIf(nAvailable > nAssigned, rgMaster.Cells(vType + vSubtype + nAssigned, 3).Value, "No IPs left")
End Function
Sub AssignIP(cel As Range)
Dim rg As Range, rgIP As Range, rgMaster As Range
Dim sType As String, sSubtype As String
Dim vIP As Variant, vType As Variant, vSubtype As Variant
Dim i As Long, nIP As Long
Set rg = cel.Offset(0, -1).CurrentRegion
Set rgMaster = Worksheets("Master").Range("A1").CurrentRegion
vType = Application.Match("Product Type", rg.Rows(1), 0)
If IsError(vType) Then
MsgBox "Could not find Product Type column"
Exit Sub
Else
vSubtype = Application.Match("Sub Product Type", rg.Rows(1), 0)
i = cel.Row - rgMaster.Row + 1
sType = rg.Cells(i, vType).Value
If Not IsError(vSubtype) Then sSubtype = rg.Cells(i, vSubtype).Value
vIP = NextIP(sType, sSubtype)
cel.Value = vIP
If IsNumeric(Left(vIP, 3)) Then
nIP = Application.Match(vIP, rgMaster.Columns(3), 0)
rgMaster.Cells(nIP, 4).Value = "X"
End If
End If
End Sub
Sub SortMasterIPs(Optional b As Boolean)
'Sorts the master IP list by type, subtype, in use and IP
Dim rg As Range
Application.ScreenUpdating = False
With Worksheets("Master")
Set rg = .Range("A1").CurrentRegion
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=rg.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=rg.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=rg.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=rg.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange rg
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
ITS-Device-deployment-PlanningQ2874.xlsm
ASKER
There is one thing I did notice, which is not so much an issue, that once the "X" is placed it does not update the "Master" sheet if an IP address in the "IP Address" column on the "IPs" sheet is deleted. I put instructions that the user must also remove the X on the Master sheet.
For not being much of an issue, it took a surprising amount of code to automate. I had to take into consideration whether a change was made to a non-IP cell, more than one IP cells were cleared, and whether the user tried to clear compound ranges.
The following two subs go in the IPs worksheet code pane. The Worksheet_Change sub is triggered whenever a cell on that worksheet has its value changed by the user or a macro. To avoid calling that sub needlessly, I modified Worksheet_BeforeDoubleClic k so it would avoid triggering Worksheet_Change.
Worksheet_Change first checks whether a compound range was changed. If so, it reverses the action and displays a warning message. Next, it checks whether the changed cells are in a Unique Identifier column, are now blank and formerly contained an IP address. If so, it reverses the change, clears the X on the corresponding row of the Master worksheet, then restores the values on the IPs worksheet.
The following two subs go in the IPs worksheet code pane. The Worksheet_Change sub is triggered whenever a cell on that worksheet has its value changed by the user or a macro. To avoid calling that sub needlessly, I modified Worksheet_BeforeDoubleClic
Worksheet_Change first checks whether a compound range was changed. If so, it reverses the action and displays a warning message. Next, it checks whether the changed cells are in a Unique Identifier column, are now blank and formerly contained an IP address. If so, it reverses the change, clears the X on the corresponding row of the Master worksheet, then restores the values on the IPs worksheet.
'This code must go in the code pane of the worksheet being watched. It won't work at all if installed anywhere else.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.EntireColumn.Cells(1, 1).Value = "Unique Identifier" Then
If Target.Cells(1, 1).Value = "" Then
Application.EnableEvents = False
AssignIP Target.Cells(1, 1)
Application.EnableEvents = True
Cancel = True
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, celHome As Range
Dim vID As Variant, vTarget As Variant
Dim bID As Boolean
Dim i As Long, j As Long, nCols As Long, nRows As Long
Const IPheader As String = "Unique Identifier"
Application.EnableEvents = False
If Target.Areas.Count > 1 Then
Application.Undo
MsgBox "It is not permitted to make changes on compound ranges in this worksheet"
Else
Application.ScreenUpdating = False
Set celHome = ActiveCell
For Each cel In Target.Cells
If (cel.EntireColumn.Cells(1, 1).Value = IPheader) And (cel.Value = "") Then
bID = True
Exit For
End If
Next
If bID = True Then
vTarget = Target.Value
nCols = Target.Columns.Count
nRows = Target.Rows.Count
Application.Undo
For i = 1 To nRows
For j = 1 To nCols
If Target.Cells.Count = 1 Then
If IsNumeric(Left(Target.Value, 3)) Then ClearTheX (Target.Value)
Else
If Target.Cells(i, j).EntireColumn.Cells(1, 1).Value = IPheader Then
If IsNumeric(Left(Target.Cells(i, j).Value, 3)) And vTarget(i, j) = "" Then ClearTheX (Target.Cells(i, j).Value)
End If
End If
Next
Next
Target.Value = vTarget
End If
Application.Goto celHome
End If
Application.EnableEvents = True
End Sub
The event sub calls sub ClearTheX, which should be placed in a regular module sheet. This sub looks for the IP address on worksheet Master, then clears the X to its right.Sub ClearTheX(vIP As Variant)
Dim rgMaster As Range
Dim nIP As Variant
Set rgMaster = Worksheets("Master").Range("A1").CurrentRegion
nIP = Application.Match(vIP, rgMaster.Columns(3), 0)
If IsNumeric(nIP) Then rgMaster.Cells(CLng(nIP), 4).ClearContents
End Sub
ITS-Device-deployment-PlanningQ2874.xlsm
I thought it might be dangerous to permit a person to clear a unique identifier and make it available for reuse, so I added a MsgBox with an "are you sure?" type warning message. If affirmative, then the identifier cell is cleared and the X removed from worksheet Master. I also thought it might be intuitive to doubleclick a unique identifier to clear it, once again after responding affirmatively to a warning message. So the user now has two ways to clear the unique identifiers, both of them safeguarded by a warning message.
'This code must go in the code pane of the worksheet being watched. It won't work at all if installed anywhere else.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.EntireColumn.Cells(1, 1).Value = "Unique Identifier" Then
If Target.Value = "" Then
Application.EnableEvents = False
AssignIP Target
Application.EnableEvents = True
ElseIf IsNumeric(Left(Target.Value, 3)) Then
If MsgBox("Is identifier for device no longer in use and available for reassignment?", vbYesNoCancel) = vbYes Then
ClearTheX (Target.Value)
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End If
Cancel = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, celHome As Range
Dim vID As Variant, vOldTarget As Variant, vTarget As Variant
Dim bID As Boolean, bLoopDone As Boolean
Dim i As Long, j As Long, nCols As Long, nRows As Long, TargCol As Long
Const IPheader As String = "Unique Identifier"
If Target.Areas.Count > 1 Then
Application.EnableEvents = False
Application.Undo
MsgBox "It is not permitted to make changes on compound ranges in this worksheet"
Application.EnableEvents = True
Else
TargCol = Target.Column
vTarget = Target.Value
nCols = Target.Columns.Count
nRows = Target.Rows.Count
If nRows * nCols = 1 Then
If (Cells(1, TargCol).Value = IPheader) And (vTarget = "") Then
If MsgBox("Is identifier for device no longer in use and available for reassignment?", vbYesNoCancel) = vbYes Then
bID = True
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End If
Else
For i = 1 To nRows
For j = 1 To nCols
If (Cells(1, TargCol + j - 1).Value = IPheader) And (vTarget(i, j) = "") Then
If MsgBox("Are identifiers for devices no longer in use and available for reassignment?", vbYesNoCancel) = vbYes Then
bID = True
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
bLoopDone = True
Exit For
End If
Next
If bLoopDone = True Then Exit For
Next
End If
If bID = True Then
Set celHome = ActiveCell
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Undo
vOldTarget = Target.Value
Target.Value = vTarget
Application.EnableEvents = True
nCols = Target.Columns.Count
nRows = Target.Rows.Count
For i = 1 To nRows
For j = 1 To nCols
If nRows * nCols = 1 Then
If IsNumeric(Left(vOldTarget, 3)) Then ClearTheX (vOldTarget)
Else
If Cells(1, TargCol + j - 1).Value = IPheader Then
If IsNumeric(Left(vOldTarget(i, j), 3)) And vTarget(i, j) = "" Then ClearTheX (vOldTarget(i, j))
End If
End If
Next
Next
Application.Goto celHome
End If
End If
End Sub
ITS-Device-deployment-PlanningQ2874.xlsm
ASKER
Awesome! Thanks...
The actual workbook (which I saw in a Private Message) did not have a Subtype column on worksheet IPs. I revised the code to tolerate its absence and to display the nag message only when necessary (trying to clear one or more cells with an IP address). The revised code appears below.
'This code must go in the code pane of the worksheet being watched. It won't work at all if installed anywhere else.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.EntireColumn.Cells(1, 1).Value = "IP Address" Then
If Target.Value = "" Then
Application.EnableEvents = False
AssignIP Target
Application.EnableEvents = True
ElseIf IsNumeric(Left(Target.Value, 3)) Then
If MsgBox("Is identifier for device no longer in use and available for reassignment?", vbYesNoCancel) = vbYes Then
ClearTheX (Target.Value)
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
Else
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
Cancel = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, celHome As Range
Dim vID As Variant, vOldTarget As Variant, vTarget As Variant
Dim bID As Boolean, bLoopDone As Boolean
Dim i As Long, j As Long, nCols As Long, nRows As Long, TargCol As Long
Set celHome = ActiveCell
Application.EnableEvents = False
If Target.Areas.Count > 1 Then
Application.Undo
MsgBox "It is not permitted to make changes on compound ranges in this worksheet"
Else
TargCol = Target.Column
vTarget = Target.Value
nCols = Target.Columns.Count
nRows = Target.Rows.Count
Application.Undo
vOldTarget = Target.Value
If nRows * nCols = 1 Then
If (Cells(1, TargCol).Value = IPheader) And (vTarget = "") And (IsNumeric(Left(vOldTarget, 3))) Then
bID = (MsgBox("Is identifier for device no longer in use and available for reassignment?", vbYesNoCancel) = vbYes)
End If
Else
For i = 1 To nRows
For j = 1 To nCols
If (Cells(1, TargCol + j - 1).Value = IPheader) And (vTarget(i, j) = "") And (IsNumeric(Left(vOldTarget(i, j), 3))) Then
bID = (MsgBox("Are identifiers for devices no longer in use and available for reassignment?", vbYesNoCancel) = vbYes)
bLoopDone = True
Exit For
End If
Next
If bLoopDone = True Then Exit For
Next
End If
If bID = True Then
Application.ScreenUpdating = False
nCols = Target.Columns.Count
nRows = Target.Rows.Count
For i = 1 To nRows
For j = 1 To nCols
If nRows * nCols = 1 Then
ClearTheX (vOldTarget)
Target.Value = vTarget
Else
If Cells(1, TargCol + j - 1).Value = IPheader Then
If IsNumeric(Left(vOldTarget(i, j), 3)) And vTarget(i, j) = "" Then ClearTheX (vOldTarget(i, j))
End If
Target.Cells(i, j).Value = vTarget(i, j)
End If
Next
Next
Else
Target.Value = vTarget
End If
Application.Goto celHome
End If
Application.EnableEvents = True
End Sub
'The public constants must match the header labels used in worksheet IPs
Public Const IPheader As String = "IP Address"
Public Const TypeHeader As String = "VLAN Device Type"
Public Const SubtypeHeader As String = "" 'Equals "" because not used
'Code assumes a four column list on worksheet Master containing Type, Subtype, IP Address and In Use. _
Type and IP Address are required, but Subtype is optional. _
In Use will be marked with an X when that row's IP Address is assigned.
'This code goes in a regular module sheet
Function NextIP(sType As String, sSubtype As String) As Variant
'Returns the next available IP address for a given type and subtype
Dim rgMaster As Range
Dim vType As Variant, vSubtype As Variant
Dim nAssigned As Long, nRows As Long, nAvailable As Long
Set rgMaster = Worksheets("Master").Range("A1").CurrentRegion
nRows = rgMaster.Rows.Count
vType = Application.Match(sType, rgMaster.Columns(1), 0)
If IsError(vType) Then
NextIP = "No type match"
Exit Function
End If
vSubtype = 0
If sSubtype <> "" Then
vSubtype = Application.Match(sSubtype, Range(rgMaster.Cells(vType, 2), rgMaster.Cells(nRows, 2)), 0)
If IsError(vSubtype) Then
NextIP = "No subtype match"
Exit Function
Else
vSubtype = vSubtype - 1
End If
End If
nAvailable = Application.CountIfs(rgMaster.Columns(1), sType, rgMaster.Columns(2), sSubtype)
nAssigned = Application.CountIfs(rgMaster.Columns(1), sType, rgMaster.Columns(2), sSubtype, rgMaster.Columns(4), "<>")
NextIP = IIf(nAvailable > nAssigned, rgMaster.Cells(vType + vSubtype + nAssigned, 3).Value, "No IPs left")
End Function
Sub AssignIP(cel As Range)
Dim rg As Range, rgIP As Range, rgMaster As Range
Dim sType As String, sSubtype As String
Dim vIP As Variant, vType As Variant, vSubtype As Variant
Dim i As Long, nIP As Long
Set rg = cel.Offset(0, -1).CurrentRegion
Set rgMaster = Worksheets("Master").Range("A1").CurrentRegion
vType = Application.Match(TypeHeader, rg.Rows(1), 0)
If IsError(vType) Then
MsgBox "Could not find Product Type column"
Exit Sub
Else
On Error Resume Next
vSubtype = Application.Match(SubtypeHeader, rg.Rows(1), 0)
On Error GoTo 0
i = cel.Row - rgMaster.Row + 1
sType = rg.Cells(i, vType).Value
If Not IsError(vSubtype) Then sSubtype = rg.Cells(i, vSubtype).Value
vIP = NextIP(sType, sSubtype)
cel.Value = vIP
If IsNumeric(Left(vIP, 3)) Then
nIP = Application.Match(vIP, rgMaster.Columns(3), 0)
rgMaster.Cells(nIP, 4).Value = "X"
End If
End If
End Sub
Sub ClearTheX(vIP As Variant)
Dim rgMaster As Range
Dim nIP As Variant
Set rgMaster = Worksheets("Master").Range("A1").CurrentRegion
nIP = Application.Match(vIP, rgMaster.Columns(3), 0)
If IsNumeric(nIP) Then rgMaster.Cells(CLng(nIP), 4).ClearContents
End Sub
Sub SortMasterIPs(Optional b As Boolean)
'Sorts the master IP list by type, subtype, in use and IP
Dim rg As Range
Application.ScreenUpdating = False
With Worksheets("Master")
Set rg = .Range("A1").CurrentRegion
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=rg.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=rg.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=rg.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=rg.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange rg
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
ASKER
This works great
...and how can we help you?
PS. A Unique ID is surely unique across all Products; not just a Product Type.
The ranges for the Identifiers you have stated above confirms this.