- Joined
- Jul 22, 2010
- Messages
- 1
- Reaction score
- 0
I've search high and low for an Excel Function that I can use with Subnetting. All suggestions pointed to using web based tools, or download this or that application but none of these let me use it in Excel ( which is what I was looking for... )
So I gave up looking and wrote one in "simple" VBA. ( I'm not a whizz, but it works! )
I hope that those people who trawl the internet to find something similar, eventually find this
This is a VBA Function for Excel. I'm going to assume you know how to add a VBA Function ( Or Macro etc ), If not I'll hope someone will reply to this thread with a simple How To.
Its very basic, but it does exactly what is says on the tin and works for me.
Input is =IPSubnetCalc(X, YY.YY.YY.YY/ZZ )
X = 1 to 5 - See below for what each option does.
Y = IPv4 Address
Z = 8 to 32, Excl 31. ( BitMask )
Obviously, the X, Y/Z can be cell references.
Enjoy
So I gave up looking and wrote one in "simple" VBA. ( I'm not a whizz, but it works! )
I hope that those people who trawl the internet to find something similar, eventually find this
This is a VBA Function for Excel. I'm going to assume you know how to add a VBA Function ( Or Macro etc ), If not I'll hope someone will reply to this thread with a simple How To.
Its very basic, but it does exactly what is says on the tin and works for me.
Input is =IPSubnetCalc(X, YY.YY.YY.YY/ZZ )
X = 1 to 5 - See below for what each option does.
Y = IPv4 Address
Z = 8 to 32, Excl 31. ( BitMask )
Obviously, the X, Y/Z can be cell references.
Enjoy
Code:
Public Function IPSubnetCalc(intFn%, IPandMaskInput$)
'# IP Subnet Calculator by Marcus Mansfield #
'# Input Expected xx.xx.xx.xx/yy #
'# Where xx = decimal IPv4 Octet #
'# yy = BitMask Value ( 8 - 32 ex.31 )#
'# Functions ... #
'# 1 - Return Subnet Mask in dotted decimal #
'# 2 - Return Subnet Address in Dot. Dec. #
'# 3 - Return Broadcast Address in Dot. Dec.#
'# 4 - Return Lowest Client IP in Dot. Dec. #
'# 5 - Return Highest Client IP in Dot. Dec.#
Dim IPAddress$, BitMask%
Dim IPOctet1%, IPOctet2%, IPOctet3%, IPOctet4%
Dim MaskOctet1%, MaskOctet2%, MaskOctet3%, MaskOctet4%
Dim Dot1%, Dot2%, Dot3%, Slash1%
Dim IPNetwork1BIN$, IPNetwork2BIN$, IPNetwork3BIN$, IPNetwork4BIN$
On Error Resume Next
Dot1 = InStr(1, IPandMaskInput, ".")
Dot2 = InStr(Dot1 + 1, IPandMaskInput, ".")
Dot3 = InStr(Dot2 + 1, IPandMaskInput, ".")
Slash1 = InStr(1, IPandMaskInput, "/")
'Check Basic Format
If Dot1 = 0 Or Dot2 = 0 Or Dot3 = 0 Or Slash1 = 0 Then
IPSubnetCalc = "Incorrect Format"
Exit Function
End If
'Split IP into 8bit Octets
IPOctet1 = Mid(IPandMaskInput, 1, Dot1 - 1)
IPOctet2 = Mid(IPandMaskInput, Dot1 + 1, Dot2 - Dot1 - 1)
IPOctet3 = Mid(IPandMaskInput, Dot2 + 1, Dot3 - Dot2 - 1)
IPOctet4 = Mid(IPandMaskInput, Dot3 + 1, Slash1 - Dot3 - 1)
BitMask = Right(IPandMaskInput, Len(IPandMaskInput) - Slash1)
If IPOctet1 > 255 Or IPOctet2 > 255 Or IPOctet3 > 255 Or IPOctet4 > 255 Then
IPSubnetCalc = "Value Error, Octet > 255"
Exit Function
End If
If IPOctet1 < 0 Or IPOctet2 < 0 Or IPOctet3 < 0 Or IPOctet4 < 0 Then
IPSubnetCalc = "Value Error, Octet < 0"
Exit Function
End If
If BitMask < 8 Or BitMask > 32 Or BitMask = 31 Then
IPSubnetCalc = "Bitmask Error : Range 8 - 32, Excl. 31"
Exit Function
End If
Select Case intFn
Case 1 'Subnet Mask Dot. Dec.
BuildBIN = ""
For iCounter = 1 To 32
If iCounter <= BitMask Then
BuildBIN = BuildBIN & "1"
Else
BuildBIN = BuildBIN & "0"
End If
Next
MaskOctet1 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 1, 8))
MaskOctet2 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 9, 8))
MaskOctet3 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 17, 8))
MaskOctet4 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 25, 8))
IPSubnetCalc = MaskOctet1 & "." & MaskOctet2 & "." & MaskOctet3 & "." & MaskOctet4
Case 2 'Subnet Dot. Dec.
BuildBIN = ""
For iCounter = 1 To 32
If iCounter <= BitMask Then
BuildBIN = BuildBIN & "1"
Else
BuildBIN = BuildBIN & "0"
End If
Next
MaskOctet1BIN = Mid(BuildBIN, 1, 8)
MaskOctet2BIN = Mid(BuildBIN, 9, 8)
MaskOctet3BIN = Mid(BuildBIN, 17, 8)
MaskOctet4BIN = Mid(BuildBIN, 25, 8)
IPOctet1BIN = Application.WorksheetFunction.Dec2Bin(IPOctet1, 8)
IPOctet2BIN = Application.WorksheetFunction.Dec2Bin(IPOctet2, 8)
IPOctet3BIN = Application.WorksheetFunction.Dec2Bin(IPOctet3, 8)
IPOctet4BIN = Application.WorksheetFunction.Dec2Bin(IPOctet4, 8)
'AND Binary Expressions.
IPNetwork1BIN = ""
IPNetwork2BIN = ""
IPNetwork3BIN = ""
IPNetwork4BIN = ""
For iCounter = 1 To 8
If Mid(MaskOctet1BIN, iCounter, 1) And Mid(IPOctet1BIN, iCounter, 1) Then
IPNetwork1BIN = IPNetwork1BIN & "1"
Else
IPNetwork1BIN = IPNetwork1BIN & "0"
End If
If Mid(MaskOctet2BIN, iCounter, 1) And Mid(IPOctet2BIN, iCounter, 1) Then
IPNetwork2BIN = IPNetwork2BIN & "1"
Else
IPNetwork2BIN = IPNetwork2BIN & "0"
End If
If Mid(MaskOctet3BIN, iCounter, 1) And Mid(IPOctet3BIN, iCounter, 1) Then
IPNetwork3BIN = IPNetwork3BIN & "1"
Else
IPNetwork3BIN = IPNetwork3BIN & "0"
End If
If Mid(MaskOctet4BIN, iCounter, 1) And Mid(IPOctet4BIN, iCounter, 1) Then
IPNetwork4BIN = IPNetwork4BIN & "1"
Else
IPNetwork4BIN = IPNetwork4BIN & "0"
End If
Next
MaskOctet1 = Application.WorksheetFunction.Bin2Dec(IPNetwork1BIN)
MaskOctet2 = Application.WorksheetFunction.Bin2Dec(IPNetwork2BIN)
MaskOctet3 = Application.WorksheetFunction.Bin2Dec(IPNetwork3BIN)
MaskOctet4 = Application.WorksheetFunction.Bin2Dec(IPNetwork4BIN)
IPSubnetCalc = MaskOctet1 & "." & MaskOctet2 & "." & MaskOctet3 & "." & MaskOctet4
Case 3 'Broadcast Dot. Dec.
BuildBIN = ""
For iCounter = 1 To 32
If iCounter <= BitMask Then
BuildBIN = BuildBIN & "1"
Else
BuildBIN = BuildBIN & "0"
End If
Next
MaskOctet1BIN = Mid(BuildBIN, 1, 8)
MaskOctet2BIN = Mid(BuildBIN, 9, 8)
MaskOctet3BIN = Mid(BuildBIN, 17, 8)
MaskOctet4BIN = Mid(BuildBIN, 25, 8)
IPOctet1BIN = Application.WorksheetFunction.Dec2Bin(IPOctet1, 8)
IPOctet2BIN = Application.WorksheetFunction.Dec2Bin(IPOctet2, 8)
IPOctet3BIN = Application.WorksheetFunction.Dec2Bin(IPOctet3, 8)
IPOctet4BIN = Application.WorksheetFunction.Dec2Bin(IPOctet4, 8)
'Create Full IP as Binary
IPFullBIN = IPOctet1BIN & IPOctet2BIN & IPOctet3BIN & IPOctet4BIN
BuildBIN = ""
For iCounter = 1 To 32
If iCounter <= BitMask Then
BuildBIN = BuildBIN & Mid(IPFullBIN, iCounter, 1)
Else
BuildBIN = BuildBIN & "1"
End If
Next
MaskOctet1 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 1, 8))
MaskOctet2 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 9, 8))
MaskOctet3 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 17, 8))
MaskOctet4 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 25, 8))
IPSubnetCalc = MaskOctet1 & "." & MaskOctet2 & "." & MaskOctet3 & "." & MaskOctet4
Case 4 'Low IP Dot Dec
BuildBIN = ""
For iCounter = 1 To 32
If iCounter <= BitMask Then
BuildBIN = BuildBIN & "1"
Else
BuildBIN = BuildBIN & "0"
End If
Next
MaskOctet1BIN = Mid(BuildBIN, 1, 8)
MaskOctet2BIN = Mid(BuildBIN, 9, 8)
MaskOctet3BIN = Mid(BuildBIN, 17, 8)
MaskOctet4BIN = Mid(BuildBIN, 25, 8)
IPOctet1BIN = Application.WorksheetFunction.Dec2Bin(IPOctet1, 8)
IPOctet2BIN = Application.WorksheetFunction.Dec2Bin(IPOctet2, 8)
IPOctet3BIN = Application.WorksheetFunction.Dec2Bin(IPOctet3, 8)
IPOctet4BIN = Application.WorksheetFunction.Dec2Bin(IPOctet4, 8)
'AND Binary Expressions.
IPNetwork1BIN = ""
IPNetwork2BIN = ""
IPNetwork3BIN = ""
IPNetwork4BIN = ""
For iCounter = 1 To 8
If Mid(MaskOctet1BIN, iCounter, 1) And Mid(IPOctet1BIN, iCounter, 1) Then
IPNetwork1BIN = IPNetwork1BIN & "1"
Else
IPNetwork1BIN = IPNetwork1BIN & "0"
End If
If Mid(MaskOctet2BIN, iCounter, 1) And Mid(IPOctet2BIN, iCounter, 1) Then
IPNetwork2BIN = IPNetwork2BIN & "1"
Else
IPNetwork2BIN = IPNetwork2BIN & "0"
End If
If Mid(MaskOctet3BIN, iCounter, 1) And Mid(IPOctet3BIN, iCounter, 1) Then
IPNetwork3BIN = IPNetwork3BIN & "1"
Else
IPNetwork3BIN = IPNetwork3BIN & "0"
End If
If Mid(MaskOctet4BIN, iCounter, 1) And Mid(IPOctet4BIN, iCounter, 1) Then
IPNetwork4BIN = IPNetwork4BIN & "1"
Else
If iCounter = 8 Then
IPNetwork4BIN = IPNetwork4BIN & "1"
Else
IPNetwork4BIN = IPNetwork4BIN & "0"
End If
End If
Next
MaskOctet1 = Application.WorksheetFunction.Bin2Dec(IPNetwork1BIN)
MaskOctet2 = Application.WorksheetFunction.Bin2Dec(IPNetwork2BIN)
MaskOctet3 = Application.WorksheetFunction.Bin2Dec(IPNetwork3BIN)
MaskOctet4 = Application.WorksheetFunction.Bin2Dec(IPNetwork4BIN)
IPSubnetCalc = MaskOctet1 & "." & MaskOctet2 & "." & MaskOctet3 & "." & MaskOctet4
Case 5 'High IP Dot Dec
BuildBIN = ""
For iCounter = 1 To 32
If iCounter <= BitMask Then
BuildBIN = BuildBIN & "1"
Else
BuildBIN = BuildBIN & "0"
End If
Next
MaskOctet1BIN = Mid(BuildBIN, 1, 8)
MaskOctet2BIN = Mid(BuildBIN, 9, 8)
MaskOctet3BIN = Mid(BuildBIN, 17, 8)
MaskOctet4BIN = Mid(BuildBIN, 25, 8)
IPOctet1BIN = Application.WorksheetFunction.Dec2Bin(IPOctet1, 8)
IPOctet2BIN = Application.WorksheetFunction.Dec2Bin(IPOctet2, 8)
IPOctet3BIN = Application.WorksheetFunction.Dec2Bin(IPOctet3, 8)
IPOctet4BIN = Application.WorksheetFunction.Dec2Bin(IPOctet4, 8)
'Create Full IP as Binary
IPFullBIN = IPOctet1BIN & IPOctet2BIN & IPOctet3BIN & IPOctet4BIN
BuildBIN = ""
For iCounter = 1 To 32
If iCounter <= BitMask Then
BuildBIN = BuildBIN & Mid(IPFullBIN, iCounter, 1)
Else
If iCounter = 32 Then
BuildBIN = BuildBIN & "0"
Else
BuildBIN = BuildBIN & "1"
End If
End If
Next
MaskOctet1 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 1, 8))
MaskOctet2 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 9, 8))
MaskOctet3 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 17, 8))
MaskOctet4 = Application.WorksheetFunction.Bin2Dec(Mid(BuildBIN, 25, 8))
IPSubnetCalc = MaskOctet1 & "." & MaskOctet2 & "." & MaskOctet3 & "." & MaskOctet4
Case Else 'Incorrect Selection
IPSubnetCalc = "Incorrect Function"
End Select
End Function