# 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
LVL 1
###### Who is Participating?

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

IT Services ConsultantCommented:
I want to assign a unique number ID to a product based on the type of product it is.

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.
ITS Technical PlannerAuthor Commented:
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.
IT Services ConsultantCommented:
OK... Potentially "Unique" then :)

...Still waiting for a question, or why you have created this thread, though.
ITS Technical PlannerAuthor Commented:
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 Services ConsultantCommented:
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.
ITS Technical PlannerAuthor Commented:
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
ITS Technical PlannerAuthor Commented:
Mechanical EngineerCommented:
I decided you might like to use VBA code to automate the assignment of IP addresses. You didn't say how you'd like it to work, so I chose to do it in response to a doubleclicked cell.

First, I normalized your IP lookup data into four columns on a newly added worksheet called Master: Type, Subtype, IP and In Use. All the valid IP addresses are listed in this worksheet. As an IP address is requested, the next available IP address for the type and subtype will be assigned, and an X placed in the fourth column.

You assign those IP addresses on worksheet IPs by doubleclicking a cell in one of the Unique Identifier columns. A Worksheet_BeforeDoubleClick event sub captures the doubleclick and calls sub AssignIP, which in turn calls function NextIP.
``````'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
AssignIP Target.Cells(1, 1)
Cancel = True
End If
End If
End Sub
``````
The AssignIP sub and NextIP function are installed on a regular module sheet. They perform the tasks of identifying the next available IP address, assigning it and marking it as an assigned address.
``````'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
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
nAssigned = Application.CountIfs(rgMaster.Columns(1), sType, rgMaster.Columns(2), sSubtype, rgMaster.Columns(4), "<>")
NextIP = rgMaster.Cells(vType + vSubtype + nAssigned, 3).Value
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
``````
When I was testing the code, I found that you had some trailing spaces after some of the IP numbers and subtypes. I had to remove those trailing spaces to get the code to work properly. So beware of the issue when you test the code in your real workbook.
ITS-Device-deployment-PlanningQ2874.xlsm

Experts Exchange Solution brought to you by

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

ITS Technical PlannerAuthor Commented:
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.

byundt, let me know if you need a recommendation or endorsement on LinkedIn.
ITS Technical PlannerAuthor Commented:
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!
Mechanical EngineerCommented:
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:
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.
Mechanical EngineerCommented:
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.
``````'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
With .Sort
.SetRange rg
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
``````
ITS-Device-deployment-PlanningQ2874.xlsm
ITS Technical PlannerAuthor Commented:
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.
Mechanical EngineerCommented:
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_BeforeDoubleClick 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.
``````'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
Mechanical EngineerCommented:
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
ITS Technical PlannerAuthor Commented:
Awesome!  Thanks...
Mechanical EngineerCommented:
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 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
If IsError(vType) Then
MsgBox "Could not find Product Type column"
Exit Sub
Else
On Error Resume Next
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
With .Sort
.SetRange rg
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
``````
ITS Technical PlannerAuthor Commented:
This works great
###### It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.