leading zeros using ActiveCell.Offset().value to insert row and value

[TimLeonard]

Here is a version that ignores missing nodes. In other words, if onl
nodes 1 and 3 exist, it will not generate anything at all for a node
-- no zones, or D or M addresses.

Excellent...I did not think about skipping node number. This doe
happen frequently.

After testing the last two posted macros there seems to be an issu
where the following section of the code is clearing more column header
then it should which results in the columns being deleted.

'Blank the columns we don't need and delete them after the sort
On Error Resume Next
For Each r In rw.Cells
i = WorksheetFunction.Match(r.Text, aCL, 0)
If Err.Number = 1004 Then r.ClearContents
Next r
On Error GoTo 0

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

Excellent...I did not think about skipping node number. This does
happen frequently.

After testing the last two posted macros there seems to be an issue
where the following section of the code is clearing more column headers
then it should which results in the columns being deleted.

What do you think the issue is?

 

[Ron Rosenfeld]

After testing the last two posted macros there seems to be an issue
where the following section of the code is clearing more column headers
then it should which results in the columns being deleted.

What do you think the issue is? I cannot tell from the information you provide, as the columns I expected to be deleted are deleted here.

 

[Ron Rosenfeld]

What do you think the issue is? I cannot tell from the information you provide, as the columns I expected to be deleted are deleted here.

On your original (first or second) workbook, CompareData had the following labels in columns B:I
NodeAddress LoopSelection DeviceAddress Merged Address DeviceType Device Types DeviceLabel ExtendedLabel

You asked that Column J (from Column E on Worksheet DeviceType) be added and my latest macro produces the following labels in columns B:J on CompareData:

NodeAddress LoopSelection DeviceAddress Merged Address DeviceType Device Types DeviceLabel ExtendedLabel TypeCodeLabel

Unless it is acting differently on your machine, it seems to be working as you have specified.

 

[TimLeonard]

On your original (first or second) workbook, CompareData had th
following labels in columns B:I
NodeAddress LoopSelection DeviceAddress Merge
Address DeviceType Device Types DeviceLabel
ExtendedLabel

You asked that Column J (from Column E on Worksheet DeviceType) be adde
and my latest macro produces the following labels in columns B:J o
CompareData:

NodeAddress LoopSelection DeviceAddress Merge
Address DeviceType Device Types DeviceLabel
ExtendedLabel TypeCodeLabel

Unless it is acting differently on your machine, it seems to be workin
as you have specified.

Thats correct, however on my machine it puts the columns in th
following order prior to the deletion of the headers:
NodeAddress LoopSelection DeviceAddress DeviceType
DeviceLabel ExtendedLabel ClipID FlashScanID
TypeID Merged Address Device Types
TypeCodeLabel

And then deletes the following columns:
ClipID FlashScanID TypeID Merged Address
Device Types TypeCodeLabe

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

On your original (first or second) workbook, CompareData had the following labels in columns B:I
NodeAddress LoopSelection DeviceAddress Merged Address DeviceType Device Types DeviceLabel ExtendedLabel

You asked that Column J (from Column E on Worksheet DeviceType) be added and my latest macro produces the following labels in columns B:J on CompareData:

NodeAddress LoopSelection DeviceAddress Merged Address DeviceType Device Types DeviceLabel ExtendedLabel TypeCodeLabel

Unless it is acting differently on your machine, it seems to be working as you have specified.

I think I may have found the cause of the confusion.

In the second workbook you posted, on the PanelData worksheet, you indicate that all the columns from I:CC are to be removed. All of the macros I have posted since then have removed those columns, but added in a column for MergedAddress.
The last set of macros added in another column for the TypeCodeLabel.

If there are other columns you want to retain, you'll need to let me know. If some of those columns I listed above are NOT being retained, you need to let me know. If the latter, there may be some changes (or variations) in column labels that I have not seen on the workbooks you have posted.

 

[Ron Rosenfeld]

---------------------------------
Thats correct, however on my machine it puts the columns in the
following order prior to the deletion of the headers:
NodeAddress LoopSelection DeviceAddress DeviceType DeviceLabel ExtendedLabel ClipID FlashScanID TypeID Merged Address Device Types TypeCodeLabel

And then deletes the following columns:
ClipID FlashScanID TypeID Merged Address Device Types TypeCodeLabel

What you post suggests that the horizontal sort did not occur, and did NOT result in an error message. That would result in "Clip ID" being the first blank column header, and everything to the right of that being deleted.

-------------------------------------------------------------------

On mine, pre-header deletion:
NodeAddress LoopSelection DeviceAddress DeviceType DeviceLabel ExtendedLabel ClipID FlashScanID TypeID Merged Address Device Types TypeCodeLabel


After header deletion (the xxxx's represent the deleted headers):
NodeAddress LoopSelection DeviceAddress DeviceType DeviceLabel ExtendedLabel xxxxx xxxxxxxx xxxxxx Merged Address Device Types TypeCodeLabel

After horizonatal Sort (the xxxx's are headers which are blank but with data below them)
NodeAddress LoopSelection DeviceAddress Merged Address DeviceType Device Types DeviceLabel ExtendedLabel TypeCodeLabel xxxxx xxxxxx xxxxxx

And then the three rightmost columns with blank headers are deleted, leaving:

NodeAddress LoopSelection DeviceAddress Merged Address DeviceType Device Types DeviceLabel ExtendedLabel TypeCodeLabel


-------------------------------------
Let me post the macro again, in case something got garbled. Another possibility is that somehow extraneous characters are creeping into your worksheet, causing some Labels to not match. Dunno how that could happen, especially since "Merged Address" is generated within the code, and if other labels were not correct, there should have been an error at some of the .Match functions lines. You are using Excel 2007, right?

If this code doesn't work, can you post the misbehaving workbook?

===================================================
Option Explicit
'column names/labels are defined here.
'they must match exactly the names on PanelData Worksheet
'include names for any added columns
' and also be the same on any sheet generated
' by this code
Public Const sNA As String = "NodeAddress"
Public Const sLS As String = "LoopSelection"
Public Const sDA As String = "DeviceAddress"
Public Const sDT As String = "DeviceType"
Public Const sDTS As String = "Device Types"
Public Const sDL As String = "DeviceLabel"
Public Const sEL As String = "ExtendedLabel"
Public Const sMA As String = "Merged Address"
Public Const sTID As String = "TypeID"
Public Const sTCL As String = "TypeCodeLabel"

Sub CreateCompareDataSheet()
'Do this on a CompareData Sheet
'Keep only columns C:H
'Remove lines with no valid Device Address; (or not as required)
'Add Merged Address Column
'Append the "missing" Merged Addresses
'Rearrange columns by horizontal sorting according to custom list
'Sort results by Merged Address
Dim wsCompareData As Worksheet
Dim wsPD As Worksheet, vPD As Variant 'Panel Data
Dim wsDT As Worksheet, vDT As Variant 'Device Type
Dim r As Range, rw As Range, rMissed As Range

Dim NAcol As Long 'NodeAddress column
Dim NAwscol As Long 'NodeAddress column on worksheet
Dim LScol As Long 'Loop Selection column
Dim LSwscol As Long 'Loop Selection column on worksheet
Dim DTcol As Long 'Device Type column
Dim sDTP As String 'Used to create Merged Address
Dim DAcol As Long 'Device Address column
Dim MAcol As Long 'Merged Address column
Dim collUsedMA As Collection 'Used Merged Address Collection
Dim collMissMA As Collection 'Missing Merged Addresses
Dim DTScol As Long 'Device Types column
Dim TIDcol As Long 'Type ID column
Dim TCLcol As Long 'Type Code Label column

Dim NumNodes As Long, NumLoops As Long
Dim NodeLoops() As Long

Dim aTemp() As Variant
Dim v As Variant
Dim i As Long, j As Long

Application.ScreenUpdating = False

Set wsPD = Worksheets("PanelData")
Set wsDT = Worksheets("DeviceType")

'Clear CompareData sheet if present; create if not
On Error Resume Next
Set wsCompareData = Worksheets("CompareData")
If Err.Number = 9 Then
Worksheets.Add
ActiveSheet.Name = "CompareData"
Set wsCompareData = Worksheets("CompareData")
End If
On Error GoTo 0
wsCompareData.Cells.Clear

'Read Panel Data into array
'Assuming zero(0) blanks in Col A
'Assume we will retain only cols C:K
'HOWEVER, IF COLUMN LOCATIONS MIGHT CHANGE, THIS PART SHOULD
' BE RE-WRITTEN TO ACCOUNT FOR THAT
With wsPD
vPD = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) _
.Offset(columnoffset:=2).Resize(columnsize:=9)
End With

'Add columns for Merged Address, Device Types and TypeCodeLabel
ReDim Preserve vPD(1 To UBound(vPD, 1), 1 To UBound(vPD, 2) + 3)
MAcol = UBound(vPD, 2) - 2
DTScol = UBound(vPD, 2) - 1
TCLcol = UBound(vPD, 2)

vPD(1, MAcol) = sMA
vPD(1, DTScol) = sDTS
vPD(1, TCLcol) = sTCL

'Get column numbers for data to create Used MergedAddress
'Also column numbers for TypeID and TypeCodeLabel
ReDim aTemp(1 To UBound(vPD, 2))
For i = 1 To UBound(vPD, 2)
aTemp(i) = vPD(1, i)
Next i
With WorksheetFunction
NAcol = .Match(sNA, aTemp, 0)
LScol = .Match(sLS, aTemp, 0)
DTcol = .Match(sDT, aTemp, 0)
DAcol = .Match(sDA, aTemp, 0)
TIDcol = .Match(sTID, aTemp, 0)
TCLcol = .Match(sTCL, aTemp, 0)
NAwscol = .Match(sNA, wsPD.Rows(1), 0)
LSwscol = .Match(sLS, wsPD.Rows(1), 0)
NumLoops = .Max(wsPD.Columns(LSwscol))
NumNodes = .Max(wsPD.Columns(NAwscol))
End With

'Decode Type ID
'Matching arrays for doing lookup (should be faster than
' doing it via the worksheet
Dim aTID() As Long, aTCL() As String
With wsDT
aTemp = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
ReDim aTID(1 To UBound(aTemp, 1))
For i = 1 To UBound(aTemp, 1)
aTID(i) = aTemp(i, 1)
Next i

ReDim aTCL(1 To UBound(aTemp, 1))
aTemp = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
For i = 1 To UBound(aTemp, 1)
aTCL(i) = aTemp(i, 1)
Next i

If UBound(aTCL) <> UBound(aTID) Then
MsgBox ("Not all Type ID's correspond to TypeCodeLabels on DeviceType worksheet")
Exit Sub
End If
End With

For i = 2 To UBound(vPD, 1)
If vPD(i, TIDcol) <> 0 Then _
vPD(i, TCLcol) = aTCL(WorksheetFunction.Match(vPD(i, TIDcol), aTID, 0))
'if no match between TCL and TID, will have runtime error here
Next i

'Create Merged Addresses
'Add Device Types Field
Set collUsedMA = New Collection
For i = 2 To UBound(vPD, 1)
Select Case vPD(i, DTcol)
Case Is = 1
sDTP = "D"
vPD(i, DTScol) = "Detector"
Case Is = 2
sDTP = "M"
vPD(i, DTScol) = "Monitor"
Case Is = 3
sDTP = "Z"
vPD(i, DTScol) = "Zone"
Case Else
sDTP = ""
End Select
If Not sDTP = "" Then
vPD(i, MAcol) = _
IIf(NumNodes > 1, "N" & Format(vPD(i, NAcol), "000"), "") & _
"L" & Format(vPD(i, LScol), "00") & _
sDTP & _
Format(vPD(i, DAcol), "000")
'Special Case for Z
vPD(i, MAcol) = Replace(vPD(i, MAcol), "L00Z", "Z")

On Error Resume Next
collUsedMA.Add Item:=vPD(i, MAcol), Key:=vPD(i, MAcol)
If Err.Number <> 0 Then
MsgBox ("Merged Address: " & vPD(i, MAcol) & _
"on Line " & i & " is a duplicate")
Exit Sub
End If
On Error GoTo 0
End If
Next i

'Develop collection of Missing Merged Addresses
Set collMissMA = New Collection

'Argument for GenLoops will be array

ReDim NodeLoops(1 To NumNodes)
With wsPD
.AutoFilterMode = False
With Range(.Cells(1, 1), .Cells(.Rows.Count, LSwscol).End(xlUp))
For i = 1 To NumNodes
.AutoFilter Field:=NAwscol, Criteria1:=i
NodeLoops(i) = WorksheetFunction.Subtotal(4, .Columns(LSwscol))
Next i
End With
.AutoFilterMode = False
End With

v = GenLoops(NodeLoops)

On Error Resume Next
For i = LBound(v) To UBound(v)
collUsedMA.Add Item:=v(i), Key:=v(i)
If Err.Number = 0 Then
collMissMA.Add Item:=v(i), Key:=v(i)
End If
Err.Clear
Next i
On Error GoTo 0

'write array to CompareData sheet
'sort by Merged Addresses and delete lines with no MA's
'then sort horizontally by first row and custom sort
'set up custom order based on fields in row 1 of panel data
'verify labels are correct

'Column Headers for Compare and Summary Sheets
'Need to be in the desired order -- will be used as a Custom Sort Order List
'Need to match exactly the headers (but not the order)
' on the PanelData worksheet
Dim aCL(1 To 9) 'custom list array of Column Labels
aCL(1) = sNA
aCL(2) = sLS
aCL(3) = sDA
aCL(4) = sMA
aCL(5) = sDT
aCL(6) = sDTS
aCL(7) = sDL
aCL(8) = sEL
aCL(9) = sTCL
ReDim aTemp(1 To UBound(vPD, 2))
For i = 1 To UBound(vPD, 2)
aTemp(i) = vPD(1, i)
Next i

On Error Resume Next
For i = 1 To UBound(aCL)
j = WorksheetFunction.Match(aCL(i), aTemp, 0)
If Err.Number <> 0 Then
MsgBox (aCL(i) & " Not exact match in Panel Data Label row")
Exit Sub
End If
Next i
On Error GoTo 0

'Write data to CompareData sheet
With wsCompareData
Set r = .Range("B1").Resize(rowsize:=UBound(vPD, 1), columnsize:=UBound(vPD, 2))
r = vPD

'Add the Missing Merged Addresses to the correct column
'Also deconstruct to fill in the NA, LS, DA and DT columns
'Possible formats
' Znnn
' LnnXnnn
' NnnnLnnXnnn

Set rw = r.Rows(1)
With WorksheetFunction
MAcol = .Match(sMA, rw, 0)
LScol = .Match(sLS, rw, 0)
DAcol = .Match(sDA, rw, 0)
DTcol = .Match(sDT, rw, 0)
NAcol = .Match(sNA, rw, 0)
End With

ReDim aTemp(1 To collMissMA.Count, 1 To r.Columns.Count)
For i = 1 To collMissMA.Count
aTemp(i, MAcol) = collMissMA(i)
aTemp(i, DAcol) = Val(Right(collMissMA(i), 3))
Select Case Left(collMissMA(i), 1)
Case Is = "Z"
aTemp(i, NAcol) = 1
aTemp(i, LScol) = 0
aTemp(i, DTcol) = 3
Case Is = "L"
aTemp(i, NAcol) = 1
aTemp(i, LScol) = Val(Mid(collMissMA(i), 2, 2))
Select Case Mid(collMissMA(i), 4, 1)
Case Is = "D"
aTemp(i, DTcol) = 1
Case Is = "M"
aTemp(i, DTcol) = 2
End Select
Case Is = "N"
aTemp(i, NAcol) = Val(Mid(collMissMA(i), 2, 3))
Select Case Mid(collMissMA(i), 8, 1)
Case Is = "D"
aTemp(i, DTcol) = 1
aTemp(i, LScol) = Val(Mid(collMissMA(i), 6, 2))
Case Is = "M"
aTemp(i, DTcol) = 2
aTemp(i, LScol) = Val(Mid(collMissMA(i), 6, 2))
Case Else 'must be Z
aTemp(i, DTcol) = 3
aTemp(i, LScol) = 0
End Select
End Select
Next i

Set rMissed = .Cells(r.Row + r.Rows.Count, r.Column).Resize(rowsize:=UBound(aTemp, 1), columnsize:=UBound(aTemp, 2))
rMissed = aTemp
Set r = Union(r, rMissed)
'Sort by Merged Address and delete those with blank MA's
'if result of sort needs to have Zones last then will need to add a dummy column for sorting
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=r.Resize(rowsize:=r.Rows.Count - 1).Offset(rowoffset:=1).Columns(MAcol), _
SortOn:=xlSortOnValues, Order:=xlAscending
With .Sort
.SetRange r
.Header = xlYes
.Orientation = xlTopToBottom
.Apply
End With
Set r = Range(r(1, MAcol).End(xlDown).Offset(rowoffset:=1), r(.Cells.Rows.Count, MAcol))
r.EntireRow.Delete

'Blank the columns we don't need and delete them after the sort
On Error Resume Next
For Each r In rw.Cells
i = WorksheetFunction.Match(r.Text, aCL, 0)
If Err.Number = 1004 Then r.ClearContents
Next r
On Error GoTo 0

'Now sort horizontally to reorder the columns
Set r = .UsedRange
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=r.Rows(1), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
CustomOrder:=Join(aCL, ",")
With .Sort
.SetRange r
.Header = xlYes
.Orientation = xlLeftToRight
.Apply
End With

'clean up by clearing sort fields
.Sort.SortFields.Clear

'Delete blank columns
Set rw = Range(r(1).End(xlToRight), r(1)(1, r.Rows(1).Cells.Count))
Set rw = rw.Offset(columnoffset:=1).Resize(columnsize:=rw.Columns.Count - 1)
rw.EntireColumn.Delete

r.EntireColumn.AutoFit
'NOTE: Cannot use RGB on Macintosh. If that is a problem, use something
'like colorindex 15
r.Rows(1).Interior.Color = RGB(191, 191, 191) 'Same gray as on your Summary Sheet

'I don't like to activate or select, but I don't know how else to
' freeze panes
.Activate
With ActiveWindow
.SplitRow = 1
.FreezePanes = True
End With

.Range("a1").Select
End With
Application.ScreenUpdating = True
End Sub

'-------------------------------------------------------
Function GenLoops(NL) As Variant
'Part 0: N001-N104 (if more than one node)
'Part 1: L01-L10 (omit if part 2 is Z)
'Part 2: D or M or Z
'Part 3: 001-159 if part 2 is D|M; 0-999 if part 2 is Z
Dim MergAddr() As String
Dim NumLoops As Long, NumNodes As Long
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long

For i = 1 To UBound(NL)
j = j + NL(i) * 2 * 159 + 1000
Next i
ReDim MergAddr(1 To j) '+1000 for the zones

NumNodes = UBound(NL)

For i = 1 To NumNodes
NumLoops = NL(i)
For j = 1 To NumLoops
For k = 1 To 2
For l = 1 To 159
m = m + 1
MergAddr(m) = _
IIf(NumNodes > 1, "N" & Format(i, "000"), "") & _
"L" & Format(j, "00") & _
IIf(k = 1, "D", "M") & _
Format(l, "000")
Next l
Next k
Next j
Next i

'add in the Zones Merged Addresses
For k = 1 To NumNodes
If NL(k) > 0 Then 'Is there at least one loop in this node
For i = 1 To 1000
m = m + 1
MergAddr(m) = _
IIf(NL(UBound(NL)) > 1, "N" & Format(k, "000"), "") & _
"Z" & Format(i - 1, "000")
Next i
End If
Next k
GenLoops = MergAddr
End Function
=========================================

 

[TimLeonard]

On mine, pre-header deletion: NodeAddress LoopSelection DeviceAddres
DeviceType DeviceLabel ExtendedLabel ClipID FlashScanID TypeID Merge
Address Device Types TypeCodeLabel After header deletion (the xxxx'
represent the deleted headers): NodeAddress LoopSelection DeviceAddres
DeviceType DeviceLabel ExtendedLabel xxxxx xxxxxxxx xxxxxx Merge
Address Device Types TypeCodeLabel After horizonatal Sort (the xxxx'
are headers which are blank but with data below them) NodeAddres
LoopSelection DeviceAddress Merged Address DeviceType Device Type
DeviceLabel ExtendedLabel TypeCodeLabel xxxxx xxxxxx xxxxxx And then th
three rightmost columns with blank headers are deleted, leaving
NodeAddress LoopSelection DeviceAddress Merged Address DeviceType Devic
Types DeviceLabel ExtendedLabel TypeCodeLabel

For me when stepping through the code using F8 it deletes all the colum
headers to the right of the "ExtendedLabel" (ClipID FlashScanID TypeI
Merged Address Device Types TypeCodeLabel) and then sorts and delete
them...

You are using Excel 2007, right? If this code doesn't work, can you pos
the misbehaving workbook?

Yes I am using 2007


Due to the file size I posted on yousendit.com
https://www.yousendit.com/download/UW16TmZlYStwaFQ0WjhUQ

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

For me when stepping through the code using F8 it deletes all the column
headers to the right of the "ExtendedLabel" (ClipID FlashScanID TypeID
Merged Address Device Types TypeCodeLabel) and then sorts and deletes
them...

Yes I am using 2007


Due to the file size I posted on yousendit.com
https://www.yousendit.com/download/UW16TmZlYStwaFQ0WjhUQw


+-------------------------------------------------------------------+
+-------------------------------------------------------------------+

This is very interesting. When I loaded this file onto my machine, it worked as I would have expected it to, whether single-stepping or setting "stops". So I restarted Excel in "safemode" and, lo and behold, I replicated the behavior you descirbe.

The fix is to change the routine that clears column labels to this. What was happening is that once the .Match returned an Error, it was not getting cleared, so once an Error occurred, all column headers to the right would be deleted. This code change will take care of that.

As to why it wasn't a problem on my machine, I have an idea and will post back shortly.

===============================
'Blank the columns we don't need and delete them after the sort
For Each r In rw.Cells
On Error Resume Next
i = WorksheetFunction.Match(r.Text, aCL, 0)
If Err.Number = 1004 Then r.ClearContents
On Error GoTo 0
Next r
==============================

 

[Ron Rosenfeld]

This is very interesting. When I loaded this file onto my machine, it worked as I would have expected it to, whether single-stepping or setting "stops". So I restarted Excel in "safemode" and, lo and behold, I replicated the behavior you descirbe.

The fix is to change the routine that clears column labels to this. What was happening is that once the .Match returned an Error, it was not getting cleared, so once an Error occurred, all column headers to the right would be deleted. This code change will take care of that.

As to why it wasn't a problem on my machine, I have an idea and will post back shortly.

===============================
'Blank the columns we don't need and delete them after the sort
For Each r In rw.Cells
On Error Resume Next
i = WorksheetFunction.Match(r.Text, aCL, 0)
If Err.Number = 1004 Then r.ClearContents
On Error GoTo 0
Next r
==============================

OK, as I suspected, here is why the error did not show up on my machine until I ran Excel in safemode.

I have an add-in for a program I use -- Microsoft Money. That program has some event code which was triggered by a calculate event in ThisWorkbook (which means the current workbook). The event code included some error code which would reset the Err.number to zero. Starting Excel in safemode resulted in that clearing not occurring. Hence you would see the problem and I did not.

I believe it is a bit more efficient to change the code above to this, rather than as I had posted above.

=============================
'Blank the columns we don't need and delete them after the sort
On Error Resume Next
For Each r In rw.Cells
i = WorksheetFunction.Match(r.Text, aCL, 0)
If Err.Number = 1004 Then r.ClearContents
Err.Clear
Next r
On Error GoTo 0
==============================

Here is the complete macro -- there are some minor changes in the comments compared with the copy you probably have, in addition to the change in the "delete column labels" routine. So please use this to ensure we are on the same page.

If this works on your machine, I think we are done with the CompareData sheet. I will be posting some questions about the Summary Sheet after I review your postings on that.

=====================================
Option Explicit
'column names/labels are defined here.
'they must match exactly the names on PanelData Worksheet
'include names for any added columns
' and also be the same on any sheet generated
' by this code
Public Const sNA As String = "NodeAddress"
Public Const sLS As String = "LoopSelection"
Public Const sDA As String = "DeviceAddress"
Public Const sDT As String = "DeviceType"
Public Const sDTS As String = "Device Types"
Public Const sDL As String = "DeviceLabel"
Public Const sEL As String = "ExtendedLabel"
Public Const sMA As String = "Merged Address"
Public Const sTID As String = "TypeID"
Public Const sTCL As String = "TypeCodeLabel"

Sub CreateCompareDataSheet()
'Do this on a CompareData Sheet
'Keep only columns C:H
'Remove lines with no valid Device Address; (or not as required)
'Add Merged Address Column
'Append the "missing" Merged Addresses
'Rearrange columns by horizontal sorting according to custom list
'Sort results by Merged Address
Dim wsCompareData As Worksheet
Dim wsPD As Worksheet, vPD As Variant 'Panel Data
Dim wsDT As Worksheet, vDT As Variant 'Device Type
Dim r As Range, rw As Range, rMissed As Range

Dim NAcol As Long 'NodeAddress column
Dim NAwscol As Long 'NodeAddress column on worksheet
Dim LScol As Long 'Loop Selection column
Dim LSwscol As Long 'Loop Selection column on worksheet
Dim DTcol As Long 'Device Type column
Dim sDTP As String 'Used to create Merged Address
Dim DAcol As Long 'Device Address column
Dim MAcol As Long 'Merged Address column
Dim collUsedMA As Collection 'Used Merged Address Collection
Dim collMissMA As Collection 'Missing Merged Addresses
Dim DTScol As Long 'Device Types column
Dim TIDcol As Long 'Type ID column
Dim TCLcol As Long 'Type Code Label column

Dim NumNodes As Long, NumLoops As Long
Dim NodeLoops() As Long

Dim aTemp() As Variant
Dim v As Variant
Dim i As Long, j As Long

Application.ScreenUpdating = False

Set wsPD = Worksheets("PanelData")
Set wsDT = Worksheets("DeviceType")

'Clear CompareData sheet if present; create if not
On Error Resume Next
Set wsCompareData = Worksheets("CompareData")
If Err.Number = 9 Then
Worksheets.Add
ActiveSheet.Name = "CompareData"
Set wsCompareData = Worksheets("CompareData")
End If
On Error GoTo 0
wsCompareData.Cells.Clear

'Read Panel Data into array
'Assuming zero(0) blanks in Col A
'Assume we will retain only cols C:K
'HOWEVER, IF COLUMN LOCATIONS MIGHT CHANGE, THIS PART SHOULD
' BE RE-WRITTEN TO ACCOUNT FOR THAT
With wsPD
vPD = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) _
.Offset(columnoffset:=2).Resize(columnsize:=9)
End With

'Add columns for Merged Address, Device Types and TypeCodeLabel
ReDim Preserve vPD(1 To UBound(vPD, 1), 1 To UBound(vPD, 2) + 3)
MAcol = UBound(vPD, 2) - 2
DTScol = UBound(vPD, 2) - 1
TCLcol = UBound(vPD, 2)

vPD(1, MAcol) = sMA
vPD(1, DTScol) = sDTS
vPD(1, TCLcol) = sTCL

'Get column numbers for data to create Used MergedAddress
'Also column numbers for TypeID and TypeCodeLabel
ReDim aTemp(1 To UBound(vPD, 2))
For i = 1 To UBound(vPD, 2)
aTemp(i) = vPD(1, i)
Next i
With WorksheetFunction
NAcol = .Match(sNA, aTemp, 0)
LScol = .Match(sLS, aTemp, 0)
DTcol = .Match(sDT, aTemp, 0)
DAcol = .Match(sDA, aTemp, 0)
TIDcol = .Match(sTID, aTemp, 0)
TCLcol = .Match(sTCL, aTemp, 0)
NAwscol = .Match(sNA, wsPD.Rows(1), 0)
LSwscol = .Match(sLS, wsPD.Rows(1), 0)
NumLoops = .Max(wsPD.Columns(LSwscol))
NumNodes = .Max(wsPD.Columns(NAwscol))
End With

'Decode Type ID
'Matching arrays for doing lookup (should be faster than
' doing it via the worksheet
Dim aTID() As Long, aTCL() As String
With wsDT
aTemp = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
ReDim aTID(1 To UBound(aTemp, 1))
For i = 1 To UBound(aTemp, 1)
aTID(i) = aTemp(i, 1)
Next i

ReDim aTCL(1 To UBound(aTemp, 1))
aTemp = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
For i = 1 To UBound(aTemp, 1)
aTCL(i) = aTemp(i, 1)
Next i

If UBound(aTCL) <> UBound(aTID) Then
MsgBox ("Not all Type ID's correspond to TypeCodeLabels on DeviceType worksheet")
Exit Sub
End If
End With

For i = 2 To UBound(vPD, 1)
If vPD(i, TIDcol) <> 0 Then _
vPD(i, TCLcol) = aTCL(WorksheetFunction.Match(vPD(i, TIDcol), aTID, 0))
'if no match between TCL and TID, will have runtime error here
Next i

'Create Merged Addresses
'Add Device Types Field
Set collUsedMA = New Collection
For i = 2 To UBound(vPD, 1)
Select Case vPD(i, DTcol)
Case Is = 1
sDTP = "D"
vPD(i, DTScol) = "Detector"
Case Is = 2
sDTP = "M"
vPD(i, DTScol) = "Monitor"
Case Is = 3
sDTP = "Z"
vPD(i, DTScol) = "Zone"
Case Else
sDTP = ""
End Select
If Not sDTP = "" Then
vPD(i, MAcol) = _
IIf(NumNodes > 1, "N" & Format(vPD(i, NAcol), "000"), "") & _
"L" & Format(vPD(i, LScol), "00") & _
sDTP & _
Format(vPD(i, DAcol), "000")
'Special Case for Z
vPD(i, MAcol) = Replace(vPD(i, MAcol), "L00Z", "Z")

On Error Resume Next
collUsedMA.Add Item:=vPD(i, MAcol), Key:=vPD(i, MAcol)
If Err.Number <> 0 Then
MsgBox ("Merged Address: " & vPD(i, MAcol) & _
"on Line " & i & " is a duplicate")
Exit Sub
End If
On Error GoTo 0
End If
Next i

'Develop collection of Missing Merged Addresses
Set collMissMA = New Collection

'Argument for GenLoops will be array
'Index represents the Node Address
'Value is the number of loops.
' If Value = 0 then there are no loops

ReDim NodeLoops(1 To NumNodes)
With wsPD
.AutoFilterMode = False
With Range(.Cells(1, 1), .Cells(.Rows.Count, LSwscol).End(xlUp))
For i = 1 To NumNodes
.AutoFilter Field:=NAwscol, Criteria1:=i
NodeLoops(i) = WorksheetFunction.Subtotal(4, .Columns(LSwscol))
Next i
End With
.AutoFilterMode = False
End With

v = GenLoops(NodeLoops)

On Error Resume Next
For i = LBound(v) To UBound(v)
collUsedMA.Add Item:=v(i), Key:=v(i)
If Err.Number = 0 Then
collMissMA.Add Item:=v(i), Key:=v(i)
End If
Err.Clear
Next i
On Error GoTo 0

'write array to CompareData sheet
'sort by Merged Addresses and delete lines with no MA's
'then sort horizontally by first row and custom sort
'set up custom order based on fields in row 1 of panel data
'verify labels are correct

'Column Headers for Compare and Summary Sheets
'Need to be in the desired order -- will be used as a Custom Sort Order List
'Need to match exactly the headers (but not the order)
' on the PanelData worksheet
Dim aCL(1 To 9) 'custom list array of Column Labels
aCL(1) = sNA
aCL(2) = sLS
aCL(3) = sDA
aCL(4) = sMA
aCL(5) = sDT
aCL(6) = sDTS
aCL(7) = sDL
aCL(8) = sEL
aCL(9) = sTCL
ReDim aTemp(1 To UBound(vPD, 2))
For i = 1 To UBound(vPD, 2)
aTemp(i) = vPD(1, i)
Next i

On Error Resume Next
For i = 1 To UBound(aCL)
j = WorksheetFunction.Match(aCL(i), aTemp, 0)
If Err.Number <> 0 Then
MsgBox (aCL(i) & " Not exact match in Panel Data Label row")
Exit Sub
End If
Next i
On Error GoTo 0

'Write data to CompareData sheet
With wsCompareData
Set r = .Range("B1").Resize(rowsize:=UBound(vPD, 1), columnsize:=UBound(vPD, 2))
r = vPD

'Add the Missing Merged Addresses to the correct column
'Also deconstruct to fill in the NA, LS, DA and DT columns
'Possible formats
' Znnn
' LnnXnnn
' NnnnLnnXnnn

Set rw = r.Rows(1)
With WorksheetFunction
MAcol = .Match(sMA, rw, 0)
LScol = .Match(sLS, rw, 0)
DAcol = .Match(sDA, rw, 0)
DTcol = .Match(sDT, rw, 0)
NAcol = .Match(sNA, rw, 0)
End With

ReDim aTemp(1 To collMissMA.Count, 1 To r.Columns.Count)
For i = 1 To collMissMA.Count
aTemp(i, MAcol) = collMissMA(i)
aTemp(i, DAcol) = Val(Right(collMissMA(i), 3))
Select Case Left(collMissMA(i), 1)
Case Is = "Z"
aTemp(i, NAcol) = 1
aTemp(i, LScol) = 0
aTemp(i, DTcol) = 3
Case Is = "L"
aTemp(i, NAcol) = 1
aTemp(i, LScol) = Val(Mid(collMissMA(i), 2, 2))
Select Case Mid(collMissMA(i), 4, 1)
Case Is = "D"
aTemp(i, DTcol) = 1
Case Is = "M"
aTemp(i, DTcol) = 2
End Select
Case Is = "N"
aTemp(i, NAcol) = Val(Mid(collMissMA(i), 2, 3))
Select Case Mid(collMissMA(i), 8, 1)
Case Is = "D"
aTemp(i, DTcol) = 1
aTemp(i, LScol) = Val(Mid(collMissMA(i), 6, 2))
Case Is = "M"
aTemp(i, DTcol) = 2
aTemp(i, LScol) = Val(Mid(collMissMA(i), 6, 2))
Case Else 'must be Z
aTemp(i, DTcol) = 3
aTemp(i, LScol) = 0
End Select
End Select
Next i

Set rMissed = .Cells(r.Row + r.Rows.Count, r.Column).Resize(rowsize:=UBound(aTemp, 1), columnsize:=UBound(aTemp, 2))
rMissed = aTemp
Set r = Union(r, rMissed)
'Sort by Merged Address and delete those with blank MA's
'if result of sort needs to have Zones last then will need to add a dummy column for sorting
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=r.Resize(rowsize:=r.Rows.Count - 1).Offset(rowoffset:=1).Columns(MAcol), _
SortOn:=xlSortOnValues, Order:=xlAscending
With .Sort
.SetRange r
.Header = xlYes
.Orientation = xlTopToBottom
.Apply
End With
Set r = Range(r(1, MAcol).End(xlDown).Offset(rowoffset:=1), r(.Cells.Rows.Count, MAcol))
r.EntireRow.Delete

'Blank the columns we don't need and delete them after the sort
On Error Resume Next
For Each r In rw.Cells
i = WorksheetFunction.Match(r.Text, aCL, 0)
If Err.Number = 1004 Then r.ClearContents
Err.Clear
Next r
On Error GoTo 0

'Now sort horizontally to reorder the columns
Set r = .UsedRange
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=r.Rows(1), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
CustomOrder:=Join(aCL, ",")
With .Sort
.SetRange r
.Header = xlYes
.Orientation = xlLeftToRight
.Apply
End With

'clean up by clearing sort fields
.Sort.SortFields.Clear

'Delete blank columns
Set rw = Range(r(1).End(xlToRight), r(1)(1, r.Rows(1).Cells.Count))
Set rw = rw.Offset(columnoffset:=1).Resize(columnsize:=rw.Columns.Count - 1)
rw.EntireColumn.Delete

r.EntireColumn.AutoFit
'NOTE: Cannot use RGB on Macintosh. If that is a problem, use something
'like colorindex 15
r.Rows(1).Interior.Color = RGB(191, 191, 191) 'Same gray as on your Summary Sheet

'I don't like to activate or select, but I don't know how else to
' freeze panes
.Activate
With ActiveWindow
.SplitRow = 1
.FreezePanes = True
End With

.Range("a1").Select
End With
Application.ScreenUpdating = True
End Sub

'-------------------------------------------------------
Function GenLoops(NL) As Variant
'Part 0: N001-N104 (if more than one node)
'Part 1: L01-L10 (omit if part 2 is Z)
'Part 2: D or M or Z
'Part 3: 001-159 if part 2 is D|M; 0-999 if part 2 is Z
Dim MergAddr() As String
Dim NumLoops As Long, NumNodes As Long
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long

For i = 1 To UBound(NL)
j = j + NL(i) * 2 * 159 + 1000
Next i
ReDim MergAddr(1 To j) '+1000 for the zones

NumNodes = UBound(NL)

For i = 1 To NumNodes
NumLoops = NL(i)
For j = 1 To NumLoops
For k = 1 To 2
For l = 1 To 159
m = m + 1
MergAddr(m) = _
IIf(NumNodes > 1, "N" & Format(i, "000"), "") & _
"L" & Format(j, "00") & _
IIf(k = 1, "D", "M") & _
Format(l, "000")
Next l
Next k
Next j
Next i

'add in the Zones Merged Addresses
For k = 1 To NumNodes
If NL(k) > 0 Then 'Is there at least one loop in this node
For i = 1 To 1000
m = m + 1
MergAddr(m) = _
IIf(NL(UBound(NL)) > 1, "N" & Format(k, "000"), "") & _
"Z" & Format(i - 1, "000")
Next i
End If
Next k
GenLoops = MergAddr
End Function
===============================================

 

[TimLeonard]

Just as you said, it fixed the issue and is working perfectly

If this works on your machine, I think we are done with the CompareDat
sheet. I will be posting some questions about the Summary Sheet after
review your postings on that.

Some Basics
--The sheet is manually populated for the columns: [DeviceType
Device Types DeviceLabel ExtendedLabel
TypeCodeLabel] It would be great to have the TypeCodeLabel as a dro
down since there is so many types to pick from.
--It would be nice to have the Summary sheet template built by th
macro. What I mean by that is if a loop was added to a node, then th
addresses would be added to the sheet by the macro rather than having t
add them manually.
--If possible, after somekind of comparison is done, then the option t
update the Summary sheet with the differences from the CompareDat
sheet

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

Just as you said, it fixed the issue and is working perfectly

If this works on your machine, I think we are done with the CompareData
sheet. I will be posting some questions about the Summary Sheet after I
review your postings on that.

Some Basics
--The sheet is manually populated for the columns: [DeviceType
Device Types DeviceLabel ExtendedLabel
TypeCodeLabel] It would be great to have the TypeCodeLabel as a drop
down since there is so many types to pick from.
--It would be nice to have the Summary sheet template built by the
macro. What I mean by that is if a loop was added to a node, then the
addresses would be added to the sheet by the macro rather than having to
add them manually.
--If possible, after somekind of comparison is done, then the option to
update the Summary sheet with the differences from the CompareDate
sheet.

I definitely agree with drop downs for populating the various columns so as to minimize errors. We can also do a sanity check on the modified line (e.g. no Zones with loops of non-zero).
I would also protect the cells that are created by the macro so as not to allow manual changes there.

What about the Project Number column that seems to exist only on the Summary sheet? How is that filled in?

By the way, I made a few more changes in the CompareData sheet. It shouldn't affect any behavior -- just a different, simpler, and more efficient method of handling the errors from the Match function when accessing the worksheet. It also runs faster, but it's not anything you would notice real time. I'll pass it along the next time I post some code.

 

[TimLeonard]

I definitely agree with drop downs for populating the various columns s
as to minimize errors. We can also do a sanity check on the modifie
line (e.g. no Zones with loops of non-zero).
I would also protect the cells that are created by the macro so as no
to allow manual changes there. I like that thought

What about the Project Number column that seems to exist only on th
Summary sheet? How is that filled in?

The project number column is also manually filled in. This is for th
projects that have been engineered but not installed in the field, so i
would not yet be in the PanelData or CompareDate worksheets. Th
thought behind this is to provide a way to reference the jobs that is i
the engineering phase and provide a way to distingiush between th
installed and the engineered. So once the device is installed in th
field, then when we get to the worksheet comparison part, it shoul
update/remove the contents of this column related to the installe
devices

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

The project number column is also manually filled in. This is for the
projects that have been engineered but not installed in the field, so it
would not yet be in the PanelData or CompareDate worksheets. The
thought behind this is to provide a way to reference the jobs that is in
the engineering phase and provide a way to distingiush between the
installed and the engineered. So once the device is installed in the
field, then when we get to the worksheet comparison part, it should
update/remove the contents of this column related to the installed
devices.

OK, I'll take that into account.
Right now I'm working on generating the initial Summary sheet. This is my plan:

If there is no Summary sheet
Make copy of CompareData and rename it Summary
Label Column A: Project Number
Generate the Dropdown lists for the Device Types and TypeCodeLabel Columns
I am generating the TypeCodeLabel list from the DeviceType worksheet. But there are a number of duplicates; and since this list has >120 entries, it should probably be alphabetized.
(I see no reason to have both DeviceType and Device Types columns be editable, as one depends on the other)
Turn Label Font RED for those columns that are not editable.
Lock those columns
UNlock the editable columns
Add DataValidation with "List" for Device Types and TypeCodeLabel
Protect worksheet.

If there is a Summary sheet (TBD)
develop the logic for comparison, overwriting, etc.

 

[TimLeonard]

This is my plan:

If there is no Summary sheet
Make copy of CompareData and rename it Summary
Label Column A: Project Number
Generate the Dropdown lists for the Device Types and TypeCodeLabe
Columns
I am generating the TypeCodeLabel list from the DeviceTyp
worksheet. But there are a number of duplicates; and since this lis
has >120 entries, it should probably be alphabetized.
(I see no reason to have both DeviceType and Device Types column
be editable, as one depends on the other)
Turn Label Font RED for those columns that are not editable.
Lock those columns
UNlock the editable columns
Add DataValidation with "List" for Device Types and TypeCodeLabel
Protect worksheet.

All of this sound perfect...

(I see no reason to have both DeviceType and Device Types columns b
editable, as one depends on the other)

I agree, perhaps this could be a dropdown as well using the [Devic
Types] column to populate the other

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[TimLeonard]

I just noticed on my machine that the CompareData marco is generatin
the zones in both the Z000-Z999 and the N001Z000-N001Z999 formats whe
there is only one node address. It works fine if there is more than on
node addres

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

I just noticed on my machine that the CompareData marco is generating
the zones in both the Z000-Z999 and the N001Z000-N001Z999 formats when
there is only one node address. It works fine if there is more than one
node address


+-------------------------------------------------------------------+
+-------------------------------------------------------------------+

Glad you caught that. It is due to a Logic Error in the GenLoops function that generates the Zone Addresses. It was checking the number of loops rather than the number of nodes, in deciding whether or not to prefix with the Nxxx. The unprefixed were from the original PanelData sheet.

Here's the corrected version, along with some other minor changes:

==============================================
Option Explicit
'column names/labels are defined here.
'they must match exactly the names on PanelData Worksheet
'include names for any added columns
' and also be the same on any sheet generated
' by this project (including the Summary Sheet)
Public Const sNA As String = "NodeAddress"
Public Const sLS As String = "LoopSelection"
Public Const sDA As String = "DeviceAddress"
Public Const sDT As String = "DeviceType"
Public Const sDTS As String = "Device Types"
Public Const sDL As String = "DeviceLabel"
Public Const sEL As String = "ExtendedLabel"
Public Const sMA As String = "Merged Address"
Public Const sTID As String = "TypeID"
Public Const sTCL As String = "TypeCodeLabel"
Public Const sPN As String = "Project Number"

Sub CreateCompareDataSheet()
'Do this on a CompareData Sheet
'Keep only columns C:H
'Remove lines with no valid Device Address; (or not as required)
'Add Merged Address Column
'Append the "missing" Merged Addresses
'Rearrange columns by horizontal sorting according to custom list
'Sort results by Merged Address
Dim wsCompareData As Worksheet
Dim wsPD As Worksheet, vPD As Variant 'Panel Data
Dim wsDT As Worksheet, vDT As Variant 'Device Type
Dim r As Range, rw As Range, rMissed As Range

Dim NAcol As Long 'NodeAddress column
Dim NAwscol As Long 'NodeAddress column on worksheet
Dim LScol As Long 'Loop Selection column
Dim LSwscol As Long 'Loop Selection column on worksheet
Dim DTcol As Long 'Device Type column
Dim sDTP As String 'Used to create Merged Address
Dim DAcol As Long 'Device Address column
Dim MAcol As Long 'Merged Address column
Dim collUsedMA As Collection 'Used Merged Address Collection
Dim collMissMA As Collection 'Missing Merged Addresses
Dim DTScol As Long 'Device Types column
Dim TIDcol As Long 'Type ID column
Dim TCLcol As Long 'Type Code Label column

Dim NumNodes As Long, NumLoops As Long
Dim NodeLoops() As Long

Dim aTemp() As Variant
Dim v As Variant
Dim i As Long, j As Long

Application.ScreenUpdating = False

Set wsPD = Worksheets("PanelData")
Set wsDT = Worksheets("DeviceType")

'Clear CompareData sheet if present; create if not
On Error Resume Next
Set wsCompareData = Worksheets("CompareData")
If Err.Number = 9 Then
Worksheets.Add
ActiveSheet.Name = "CompareData"
Set wsCompareData = Worksheets("CompareData")
End If
On Error GoTo 0
wsCompareData.Cells.Clear

'Read Panel Data into array
'Assuming zero(0) blanks in Col A
'Assume we will retain only cols C:K
'HOWEVER, IF COLUMN LOCATIONS MIGHT CHANGE, THIS PART SHOULD
' BE RE-WRITTEN TO ACCOUNT FOR THAT
With wsPD
vPD = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) _
.Offset(columnoffset:=2).Resize(columnsize:=9)
End With

'Add columns for Merged Address, Device Types and TypeCodeLabel
ReDim Preserve vPD(1 To UBound(vPD, 1), 1 To UBound(vPD, 2) + 3)
MAcol = UBound(vPD, 2) - 2
DTScol = UBound(vPD, 2) - 1
TCLcol = UBound(vPD, 2)

vPD(1, MAcol) = sMA
vPD(1, DTScol) = sDTS
vPD(1, TCLcol) = sTCL

'Get column numbers for data to create Used MergedAddress
'Also column numbers for TypeID and TypeCodeLabel
ReDim aTemp(1 To UBound(vPD, 2))
For i = 1 To UBound(vPD, 2)
aTemp(i) = vPD(1, i)
Next i
With WorksheetFunction
NAcol = .Match(sNA, aTemp, 0)
LScol = .Match(sLS, aTemp, 0)
DTcol = .Match(sDT, aTemp, 0)
DAcol = .Match(sDA, aTemp, 0)
TIDcol = .Match(sTID, aTemp, 0)
TCLcol = .Match(sTCL, aTemp, 0)
NAwscol = .Match(sNA, wsPD.Rows(1), 0)
LSwscol = .Match(sLS, wsPD.Rows(1), 0)
NumLoops = .Max(wsPD.Columns(LSwscol))
NumNodes = .Max(wsPD.Columns(NAwscol))
End With

'Decode Type ID
'Matching arrays for doing lookup (should be faster than
' doing it via the worksheet
Dim aTID() As Long, aTCL() As String
With wsDT
aTemp = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
ReDim aTID(1 To UBound(aTemp, 1))
For i = 1 To UBound(aTemp, 1)
aTID(i) = aTemp(i, 1)
Next i

ReDim aTCL(1 To UBound(aTemp, 1))
aTemp = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
For i = 1 To UBound(aTemp, 1)
aTCL(i) = aTemp(i, 1)
Next i

If UBound(aTCL) <> UBound(aTID) Then
MsgBox ("Not all Type ID's correspond to TypeCodeLabels on DeviceType worksheet")
Exit Sub
End If
End With

For i = 2 To UBound(vPD, 1)
If vPD(i, TIDcol) <> 0 Then _
vPD(i, TCLcol) = aTCL(WorksheetFunction.Match(vPD(i, TIDcol), aTID, 0))
'if no match between TCL and TID, will have runtime error here
Next i

'Create Merged Addresses
'Add Device Types Field
Set collUsedMA = New Collection
For i = 2 To UBound(vPD, 1)
Select Case vPD(i, DTcol)
Case Is = 1
sDTP = "D"
vPD(i, DTScol) = "Detector"
Case Is = 2
sDTP = "M"
vPD(i, DTScol) = "Monitor"
Case Is = 3
sDTP = "Z"
vPD(i, DTScol) = "Zone"
Case Else
sDTP = ""
End Select
If Not sDTP = "" Then
vPD(i, MAcol) = _
IIf(NumNodes > 1, "N" & Format(vPD(i, NAcol), "000"), "") & _
"L" & Format(vPD(i, LScol), "00") & _
sDTP & _
Format(vPD(i, DAcol), "000")
'Special Case for Z
vPD(i, MAcol) = Replace(vPD(i, MAcol), "L00Z", "Z")

On Error Resume Next
collUsedMA.Add Item:=vPD(i, MAcol), Key:=vPD(i, MAcol)
If Err.Number <> 0 Then
MsgBox ("Merged Address: " & vPD(i, MAcol) & _
"on Line " & i & " is a duplicate")
Exit Sub
End If
On Error GoTo 0
End If
Next i

'Develop collection of Missing Merged Addresses
Set collMissMA = New Collection

'Argument for GenLoops will be array
'Index represents the Node Address
'Value is the number of loops.
' If Value = 0 then there are no loops

ReDim NodeLoops(1 To NumNodes)
With wsPD
.AutoFilterMode = False
With Range(.Cells(1, 1), .Cells(.Rows.Count, LSwscol).End(xlUp))
For i = 1 To NumNodes
.AutoFilter Field:=NAwscol, Criteria1:=i
NodeLoops(i) = WorksheetFunction.Subtotal(4, .Columns(LSwscol))
Next i
End With
.AutoFilterMode = False
End With

v = GenLoops(NodeLoops)

On Error Resume Next
For i = LBound(v) To UBound(v)
collUsedMA.Add Item:=v(i), Key:=v(i)
If Err.Number = 0 Then
collMissMA.Add Item:=v(i), Key:=v(i)
End If
Err.Clear
Next i
On Error GoTo 0

'write array to CompareData sheet
'sort by Merged Addresses and delete lines with no MA's
'then sort horizontally by first row and custom sort
'set up custom order based on fields in row 1 of panel data
'verify labels are correct

'Column Headers for Compare and Summary Sheets
'Need to be in the desired order -- will be used as a Custom Sort Order List
'Need to match exactly the headers (but not the order)
' on the PanelData worksheet
Dim aCL(1 To 9) As String 'custom list array of Column Labels
aCL(1) = sNA
aCL(2) = sLS
aCL(3) = sDA
aCL(4) = sMA
aCL(5) = sDT
aCL(6) = sDTS
aCL(7) = sDL
aCL(8) = sEL
aCL(9) = sTCL
ReDim aTemp(1 To UBound(vPD, 2))
For i = 1 To UBound(vPD, 2)
aTemp(i) = vPD(1, i)
Next i

For i = 1 To UBound(aCL)
If IsError(Application.Match(aCL(i), aTemp, 0)) Then
MsgBox (aCL(i) & " Not exact match in Panel Data Label row")
Exit Sub
End If
Next i

'Write data to CompareData sheet
With wsCompareData
Set r = .Range("B1").Resize(rowsize:=UBound(vPD, 1), columnsize:=UBound(vPD, 2))
r = vPD

'Add the Missing Merged Addresses to the correct column
'Also deconstruct to fill in the NA, LS, DA and DT columns
'Possible formats
' Znnn
' LnnXnnn
' NnnnLnnXnnn

Set rw = r.Rows(1)
With WorksheetFunction
MAcol = .Match(sMA, rw, 0)
LScol = .Match(sLS, rw, 0)
DAcol = .Match(sDA, rw, 0)
DTcol = .Match(sDT, rw, 0)
NAcol = .Match(sNA, rw, 0)
End With

ReDim aTemp(1 To collMissMA.Count, 1 To r.Columns.Count)
For i = 1 To collMissMA.Count
aTemp(i, MAcol) = collMissMA(i)
aTemp(i, DAcol) = Val(Right(collMissMA(i), 3))
Select Case Left(collMissMA(i), 1)
Case Is = "Z"
aTemp(i, NAcol) = 1
aTemp(i, LScol) = 0
aTemp(i, DTcol) = 3
Case Is = "L"
aTemp(i, NAcol) = 1
aTemp(i, LScol) = Val(Mid(collMissMA(i), 2, 2))
Select Case Mid(collMissMA(i), 4, 1)
Case Is = "D"
aTemp(i, DTcol) = 1
Case Is = "M"
aTemp(i, DTcol) = 2
End Select
Case Is = "N"
aTemp(i, NAcol) = Val(Mid(collMissMA(i), 2, 3))
Select Case Mid(collMissMA(i), 8, 1)
Case Is = "D"
aTemp(i, DTcol) = 1
aTemp(i, LScol) = Val(Mid(collMissMA(i), 6, 2))
Case Is = "M"
aTemp(i, DTcol) = 2
aTemp(i, LScol) = Val(Mid(collMissMA(i), 6, 2))
Case Else 'must be Z
aTemp(i, DTcol) = 3
aTemp(i, LScol) = 0
End Select
End Select
Next i

Set rMissed = .Cells(r.Row + r.Rows.Count, r.Column).Resize(rowsize:=UBound(aTemp, 1), columnsize:=UBound(aTemp, 2))
rMissed = aTemp
Set r = Union(r, rMissed)
'Sort by Merged Address and delete those with blank MA's
'if result of sort needs to have Zones last then will need to add a dummy column for sorting
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=r.Resize(rowsize:=r.Rows.Count - 1).Offset(rowoffset:=1).Columns(MAcol), _
SortOn:=xlSortOnValues, Order:=xlAscending
With .Sort
.SetRange r
.Header = xlYes
.Orientation = xlTopToBottom
.Apply
End With
Set r = Range(r(1, MAcol).End(xlDown).Offset(rowoffset:=1), r(.Cells.Rows.Count, MAcol))
r.EntireRow.Delete

'Blank the columns we don't need and delete them after the sort
For Each r In rw.Cells
If IsError(Application.Match(r.Text, aCL, 0)) _
Then r.ClearContents
Next r

'Now sort horizontally to reorder the columns
Set r = .UsedRange
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=r.Rows(1), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
CustomOrder:=Join(aCL, ",")
With .Sort
.SetRange r
.Header = xlYes
.Orientation = xlLeftToRight
.Apply
End With

'clean up by clearing sort fields
.Sort.SortFields.Clear

'Delete blank columns
Set rw = Range(r(1).End(xlToRight), r(1)(1, r.Rows(1).Cells.Count))
Set rw = rw.Offset(columnoffset:=1).Resize(columnsize:=rw.Columns.Count - 1)
rw.EntireColumn.Delete

r.EntireColumn.AutoFit
'NOTE: Cannot use RGB on Macintosh. If that is a problem, use something
'like colorindex 15
r.Rows(1).Interior.Color = RGB(191, 191, 191) 'Same gray as on your Summary Sheet

'I don't like to activate or select, but I don't know how else to
' freeze panes
.Activate
With ActiveWindow
.SplitRow = 1
.FreezePanes = True
End With

.Range("a1").Select
End With
Application.ScreenUpdating = True
End Sub

'-------------------------------------------------------
Private Function GenLoops(NL) As Variant
'Part 0: N001-N104 (if more than one node)
'Part 1: L01-L10 (omit if part 2 is Z)
'Part 2: D or M or Z
'Part 3: 001-159 if part 2 is D|M; 0-999 if part 2 is Z
Dim MergAddr() As String
Dim NumLoops As Long, NumNodes As Long
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long

For i = 1 To UBound(NL)
j = j + NL(i) * 2 * 159 + 1000
Next i
ReDim MergAddr(1 To j) '+1000 for the zones

NumNodes = UBound(NL)

For i = 1 To NumNodes
NumLoops = NL(i)
For j = 1 To NumLoops
For k = 1 To 2
For l = 1 To 159
m = m + 1
MergAddr(m) = _
IIf(NumNodes > 1, "N" & Format(i, "000"), "") & _
"L" & Format(j, "00") & _
IIf(k = 1, "D", "M") & _
Format(l, "000")
Next l
Next k
Next j
Next i

'add in the Zones Merged Addresses
For k = 1 To NumNodes
If NL(k) > 0 Then 'Is there at least one loop in this node
For i = 1 To 1000
m = m + 1
MergAddr(m) = _
IIf(NumNodes > 1, "N" & Format(k, "000"), "") & _
"Z" & Format(i - 1, "000")
Next i
End If
Next k
GenLoops = MergAddr
End Function
==============================================

 

[Ron Rosenfeld]

This is my plan:

If there is no Summary sheet
Make copy of CompareData and rename it Summary
Label Column A: Project Number
Generate the Dropdown lists for the Device Types and TypeCodeLabel
Columns
I am generating the TypeCodeLabel list from the DeviceType
worksheet. But there are a number of duplicates; and since this list
has >120 entries, it should probably be alphabetized.
(I see no reason to have both DeviceType and Device Types columns
be editable, as one depends on the other)
Turn Label Font RED for those columns that are not editable.
Lock those columns
UNlock the editable columns
Add DataValidation with "List" for Device Types and TypeCodeLabel
Protect worksheet.

All of this sound perfect...

(I see no reason to have both DeviceType and Device Types columns be
editable, as one depends on the other)

I agree, perhaps this could be a dropdown as well using the [Device
Types] column to populate the other.


+-------------------------------------------------------------------+
+-------------------------------------------------------------------+

Tim,
Here is a preliminary version of a macro to Create the Summary sheet.
At this time, it will always create a new sheet -- I want to get the formatting and locking correct first. I've generated the dropdown lists for data entry, but haven't incorporated them yet.

I think the formatting should be different for data/cells that the user can alter, so this is reflected in the worksheet and can, of course, be modified.

Some questions:
Should we prevent modification of any lines that exist in CompareData? In other words, for example, L01D001 already has entries for Device Types, DeviceLabel andl TypeCodeLabel; Extended Label is blank. Should we "lock" the entire row since the CompareData sheet, having been generated from PanelData, should take precedence? Or not? Or lock all except Extended Label?

Will the user be allowed to add Loops and/or Nodes to the sheet?
If so, we probably need a command button to allow that; and regenerate the sheet with the extra rows.
If allowed, will they be sequential? Or will the user need to specify a Node Address and/or Loop Selection?
Will the workbook with the user modifiable Summary sheet also have CompareData, PanelData and DeviceType sheets? Or will it be a standalone?

 

[TimLeonard]

Some questions:
Should we prevent modification of any lines that exist i
CompareData? In other words, for example, L01D001 already has entrie
for Device Types, DeviceLabel andl TypeCodeLabel; Extende
Label is blank. Should we "lock" the entire row since the CompareDat
sheet, having been generated from PanelData, should take precedence? O
not? Or lock all except Extended Label?

No because there will be times when an address/device exist on th
CompareData sheet but will need to be changed to a different devic
type. For example, in existing devise is a Smoke(Photo) detector and i
could be changed to a Heat Detector in the engineering phase

Will the user be allowed to add Loops and/or Nodes to the sheet?
If so, we probably need a command button to allow that; an
regenerate the sheet with the extra rows.
If allowed, will they be sequential? Or will the user need t
specify a Node Address and/or Loop Selection?

Yes the user will be adding loops, and because the loops could serv
upper or lower floors there would be times when they are not sequentia

To be flexable I would say yes if more than one dode exist than the
would need to a Node Address and Loop Selection

Will the workbook with the user modifiable Summary sheet als
have CompareData, PanelData and DeviceType sheets? Or will it be
standalone?

Yes the workbook would always have all the worksheet

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

No because there will be times when an address/device exist on the
CompareData sheet but will need to be changed to a different device
type. For example, in existing devise is a Smoke(Photo) detector and it
could be changed to a Heat Detector in the engineering phase

Yes the user will be adding loops, and because the loops could serve
upper or lower floors there would be times when they are not sequential

To be flexable I would say yes if more than one dode exist than they
would need to a Node Address and Loop Selection

Yes the workbook would always have all the worksheets


+-------------------------------------------------------------------+
+-------------------------------------------------------------------+

Hi Tim,

Here is a preliminary (very preliminary) macro to "create" the Summary worksheet.
As written, it creates a new sheet each time it runs -- but this is only for debugging purposes.

It only allows selecting those cells which we allow the user to modify. But the protection is not password protected (that can be added if you want).
It has the dropdown selections for Device Types and TypeCodeLabel. The TypeCodeLabel dropdown is generated "on the fly" from the DeviceType worksheet.

At present, it does NOT allow for the adding of new loops or nodes -- that will be added.

Since it is created from the CompareData worksheet, so it requires that the CompareData worksheet be "up to date" before running. So I am thinking that before Summary is created, it will need to Call the CreateCompareData macro -- do you see any problem with that?

Comments and suggestions on the formatting, locking, etc would be appreciated. Also if you have any comments, thoughts on the dropdown for the TypeCodeLabel. At present, there are over 100 entries, but they don't seem to be organized in such a way as to make use of cascading lists. I did alphabetize the list, so that might help a bit.

The next step will be to mark those lines which are NOT present in the CompareData sheet, so as to preserve them when changes such as adding nodes or loops are made. And will also give a start to generating a sheet with the "differences".

=====================================================
Option Explicit
Sub CreateSummarySheet()
'note that the strings denoting the column labels are accessible
'since they were Dim'd as Public in CompareData module
Dim wsSummary As Worksheet
Dim wsCompare As Worksheet
Dim wsDT As Worksheet
Dim aCL() As String 'Column Labels
Dim rSrc As Range, vSrc As Variant 'The Data Table
Dim valDTS As String 'Validation List for Device Types
Dim valTCL As String 'Validation List for TypeCodeLabel
Dim colTCL As Collection 'need to generate unique lists
Dim vTemp As Variant
Dim r As Range
Dim i As Long
Set wsCompare = Worksheets("CompareData")
Set wsDT = Worksheets("DeviceType")
'If Summary worksheet does not exist, create it
'FOR NOW, always delete
' BUT THIS IS ONLY TO GET FORMATTING AND BASIC LAYOUT OK
'Identical to CompareData except Label and Format A1
' If it does exist, will need to compare with CompareData
On Error Resume Next
Set wsSummary = Worksheets("Summary")

'Delete these two lines when done with formatting stuff
Application.DisplayAlerts = False: wsSummary.Delete
Set wsSummary = Worksheets("Summary")

If Err.Number = 9 Then
On Error GoTo 0
wsCompare.Copy before:=wsCompare
End If
For i = 1 To Worksheets.Count
If Worksheets(i).Name Like wsCompare.Name & " (#*)" Then
Worksheets(i).Name = "Summary"
Exit For
End If
Next i
Set wsSummary = Worksheets("Summary")
With wsSummary
.Unprotect
.Cells(1, 1) = sPN
.Cells(1, 2).Copy
.Cells(1, 1).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Columns(1).AutoFit
Set rSrc = .UsedRange
vSrc = rSrc
End With

'Column Labels in order
ReDim aCL(1 To UBound(vSrc, 2))
For i = 1 To UBound(vSrc, 2)
aCL(i) = vSrc(1, i)
Next i

'setup the dropdown lists
valDTS = Join(Array("Detector", "Motion", "Zone"), ",")
'Generate the TypeCodeLabel drop down from the Device Type Sheet
'Need to get unique list as there are repeats
Set colTCL = New Collection
With Worksheets("DeviceType")
Set r = .Range("E2", .Cells(Rows.Count, "E").End(xlUp))
End With
On Error Resume Next
For i = 1 To r.Rows.Count
colTCL.Add Item:=CStr(r(i)), Key:=CStr(r(i))
Next i
On Error GoTo 0


ReDim vTemp(1 To colTCL.Count)
For i = 1 To colTCL.Count
vTemp(i) = colTCL(i)
Next i
'Probably should alphabetize this list
Quick_Sort vTemp, 1, UBound(vTemp)
valTCL = Join(vTemp, ",")


'Red Font Column Headers indicate NO Manual Entry
'Need to Protect those columns also
'Can only select editable cells so unlock
'Add Dropdown list to DeviceTypes and TypeCodeLabel cells

With rSrc.Rows(1)
For i = 1 To UBound(aCL)
Select Case aCL(i)
Case sDTS, sTCL 'add drop-down lists
With .Cells(WorksheetFunction.Match _
(aCL(i), aCL, 0))
.Font.Color = vbBlack
.Font.Bold = True
With .Resize(rowsize:=rSrc.Rows.Count - 1).Offset(rowoffset:=1)
.Locked = False
With .Validation
.Delete
.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=IIf(aCL(i) = sDTS, valDTS, valTCL)
.ErrorMessage = "Enter only from the drop down list"
.ErrorTitle = aCL(i)
.InCellDropdown = True
.InputMessage = "Enter " & aCL(i) & " from drop-down list"
.InputTitle = aCL(i)
End With
End With
End With

Case sDL, sEL, sPN
With .Cells(WorksheetFunction.Match _
(aCL(i), aCL, 0))
.Font.Color = vbBlack
.Font.Bold = True
With .Resize(rowsize:=rSrc.Rows.Count - 1).Offset(rowoffset:=1)
.Locked = False
End With
End With
Case Else
With .Cells(WorksheetFunction.Match _
(aCL(i), aCL, 0))
.Font.Color = vbRed
.Font.Bold = True
With .Resize(rowsize:=rSrc.Rows.Count).Offset(rowoffset:=1)
.Font.Color = vbRed
.Font.Italic = True
.HorizontalAlignment = xlCenter
End With
End With
End Select
Next i
End With

wsSummary.Protect
wsSummary.EnableSelection = xlUnlockedCells
[a2].Select

End Sub

Sub Quick_Sort(ByRef SortArray As Variant, ByVal First As Long, ByVal Last As Long)
Dim Low As Long, High As Long
Dim Temp As Variant, List_Separator As Variant
Low = First
High = Last
List_Separator = SortArray((First + Last) / 2)
Do
Do While (SortArray(Low) < List_Separator)
Low = Low + 1
Loop
Do While (SortArray(High) > List_Separator)
High = High - 1
Loop
If (Low <= High) Then
Temp = SortArray(Low)
SortArray(Low) = SortArray(High)
SortArray(High) = Temp
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub
================================================