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

On Sun, 17 Feb 2013 04:47:27 +0000, TimLeonard wrote:


OK, here is code that I am happy with that creates the CompareData sheet
with the above constraint. Let me know if you encounter any problems,
or see any issues.

For what I can tell its working perfectly


I will start to look at your request about incorporating information
from the DeviceType worksheet subsequently.

Thank you again for your time and efforts I do appreciate it



This one include the TypeCodeLabel in column J on CompareData.

This macro assumes that PanelData and DeviceType are in the same workbook (which must be .xlsm or .xlsb). The macro is installed into that workbook.
I used the full PanelData and DeviceType sheets you sent me in your last posting of workbooks.

I did not do extensive testing, so let me know how it works.

As written, it assumes there will be no "skipped" NodeAddress's. In other words, if there is a NodeAddress #4, #'s 1, 2, and 3 must also exist (but if there are no Loops in the missing Nodes, only Zone MergedAddresses will be generated.

==============================================
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 2D array
'Dimension1 - Node
'Dimenstion2 - Loops in corresponding Node

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.C olumns.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, 1)

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
j = UBound(MergAddr) - 1000 * UBound(NL)
For k = 1 To NumNodes
For i = 1 To 1000
MergAddr(j + i + (1000 * (k - 1))) = _
IIf(NumNodes 1, "N" & Format(k, "000"), "") & _
"Z" & Format(i - 1, "000")
Next i
Next k
GenLoops = MergAddr
End Function
===================================

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

On Sun, 17 Feb 2013 04:47:27 +0000, TimLeonard wrote:


OK, here is code that I am happy with that creates the CompareData sheet
with the above constraint. Let me know if you encounter any problems,
or see any issues.

For what I can tell its working perfectly


I will start to look at your request about incorporating information
from the DeviceType worksheet subsequently.

Thank you again for your time and efforts I do appreciate it


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

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

======================================
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 2D array
'Dimension1 - Node
'Dimenstion2 - Loops in corresponding Node

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.C olumns.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
=====================================

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.

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

On Mon, 18 Feb 2013 16:58:44 +0000, TimLeonard wrote:



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

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.


'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




What do you think the issue is?

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

On Mon, 18 Feb 2013 16:58:44 +0000, TimLeonard wrote:

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.

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

On Mon, 18 Feb 2013 15:53:21 -0500, Ron Rosenfeld wrote:

On Mon, 18 Feb 2013 16:58:44 +0000, TimLeonard wrote:

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.

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.

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

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

On Mon, 18 Feb 2013 16:05:18 -0500, Ron Rosenfeld wrote:

On Mon, 18 Feb 2013 15:53:21 -0500, Ron Rosenfeld wrote:

On Mon, 18 Feb 2013 16:58:44 +0000, TimLeonard wrote:

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.

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.

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

On Mon, 18 Feb 2013 21:55:45 +0000, TimLeonard wrote:

---------------------------------
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.C olumns.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
=========================================

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/U...YStwaFQ0WjhUQw

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

On Tue, 19 Feb 2013 03:56:01 +0000, TimLeonard wrote:



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

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...


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


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


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

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
==============================

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

On Tue, 19 Feb 2013 07:29:27 -0500, Ron Rosenfeld wrote:

On Tue, 19 Feb 2013 03:56:01 +0000, TimLeonard wrote:



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

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...


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


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


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

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.C olumns.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
===============================================

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

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.

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

On Tue, 19 Feb 2013 16:57:10 +0000, TimLeonard wrote:


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.

I like that thought
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.

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

On Tue, 19 Feb 2013 22:16:13 +0000, TimLeonard wrote:

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.

All of this sound perfect...

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

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

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

On Wed, 20 Feb 2013 21:08:48 +0000, TimLeonard wrote:


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.C olumns.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
==============================================

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

On Wed, 20 Feb 2013 03:40:08 +0000, TimLeonard wrote:



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?

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

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

On Sun, 24 Feb 2013 01:05:13 +0000, TimLeonard wrote:



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?
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


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?
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


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

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 befo=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
================================================

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

On Sun, 24 Feb 2013 09:20:09 -0500, Ron Rosenfeld wrote:

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.

Hmmm. Seems to be a problem. When I save the workbook, and try to re-open, Excel finds bad data; it removes the data validation.
We'll need a new approach -- it's probably for the Type Code Labels. I'll have to look into that.

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

On Sun, 24 Feb 2013 11:20:02 -0500, Ron Rosenfeld wrote:

On Sun, 24 Feb 2013 09:20:09 -0500, Ron Rosenfeld wrote:

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.

Hmmm. Seems to be a problem. When I save the workbook, and try to re-open, Excel finds bad data; it removes the data validation.
We'll need a new approach -- it's probably for the Type Code Labels. I'll have to look into that.

While I look into this further, I have found that saving the book in the binary format (.xlsb) enables it to be re-opened without causing that error message. (It also reduces the file size to 1/3 of the .xlsm version). So you could do this while examiining the format.

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

On Sun, 24 Feb 2013 11:48:46 -0500, Ron Rosenfeld wrote:

While I look into this further, I have found that saving the book in the binary format (.xlsb) enables it to be re-opened without causing that error message. (It also reduces the file size to 1/3 of the .xlsm version). So you could do this while examiining the format.

A further note on this issue. By placing the validation list on a separate worksheet, rather than setting it up as a comma delimited string, the workbook can be saved (and re-opened) as an .xslm file. So this will not impede anything. Instead of developing the string, we merely add a hidden worksheet, and place the elements there). I still want to figure out what's going on, though.

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

On Sun, 24 Feb 2013 01:05:13 +0000, TimLeonard wrote:



More questions (getting into the listing of differences):

Will data on the Summary sheet be deleted? In other words, could a device be completely removed?

My initial thinking was that we only need to check rows that have data in any of the user-modifiable fields on the Summary sheet.
If the engineers can DELETE data, we would also need to check rows that have data in those fields on the CompareData sheet.

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

On Mon, 25 Feb 2013 10:35:13 -0500, Ron Rosenfeld wrote:

On Sun, 24 Feb 2013 01:05:13 +0000, TimLeonard wrote:



More questions (getting into the listing of differences):

Will data on the Summary sheet be deleted? In other words, could a device be completely removed?

My initial thinking was that we only need to check rows that have data in any of the user-modifiable fields on the Summary sheet.
If the engineers can DELETE data, we would also need to check rows that have data in those fields on the CompareData sheet.


Further question as I am getting into this Summary sheet.

It seems to me there is no need to allow changes by the end user in the Device Types column.
Because of how the sheet is set up, with all possible node/loop/device addresses, the DeviceType and Device Types are already defined by their row. They have already been assigned a merged address. So an Engineer should not be adding a Monitor to the Detector segment, etc.

Right now, the Device Types column is blank if there is no device (although the DeviceType column is populated; and the MergedAddress reflects the DeviceType appropriate for that line). But we could just add event code so that if anything gets filled in on the other editable columns in that row, Device Types would be populated appropriately also.

What do you think?

Sorry for the delayed responce
No i don't see any issues with this, in fact it would be the best way to ensure the latest data

I think the formatting/locking as suggested will work out great but will need some additional thought and suggestions when it gets down to the comparrision and updating the summary sheet from the comparedata sheet so I don't know what to say yet...As for the drop down, there is really only about 10 to 15 device types that is regularly used so I will let you know which ones they are in another post. This may be a field that utilizes the pull down or manually inputed for the odd occausions...is that possible to keep the size of the pull down smaller

Hidden sheets are fine, I don't see any problems with that

Yes there will be times that the engineer will delete/remove data from a row. This would mean that the data in the [Device Types, DeviceLabel, ExtendedLabel, TypeCodeLabel] fields would be removed/deleted. There would also be times when the device is changed, for example the device could be changed from a Smoke(Photo) to a Smoke(Duct P) The CompareData sheet won't reflect this change until it is programmed in the field panel...

I agree with you, infact the [DeviceType] column servers no purpose once the [Device Types] populate the Detector, Monitor, and Zones. for the MergedAddress Fields

Really since the [Merged Address] and the [DeviceType] is prepopulated, and the [Device Types] can only follow the 1,2,3 meaning Detector, Module or Zone it could be prepopulated as well. So in reallity only columns H, I & J are the ones that matter and need to be flexable if we are thinking left to right on the spreadsheet...
If we are thinking top to bottom there will be times that adding Nodes, Loops and Address will be necassary...

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

On Mon, 25 Feb 2013 23:23:20 +0000, TimLeonard wrote:


Sorry for the delayed responce


SNIPPED

Here are some updated macros to try out.

You should install them in separate modules.

The first is to create the compare sheet, but it also has some universally used constants defined or declared.

The second creates both the summary sheet, and also adds in event code for that sheet so as to enable the automatic updating of the Device Types column if an editable column is changed. The event code within that module is not easily understood, but after the sheet is created, you can see it by right clicking on the worksheet "Summary" tab, and viewing the code in the window that opens.

Some caveats:

1. Save the workbook in BINARY format (.xlsb). I will eventually get around to putting the dropdown on a separate worksheet, but haven't yet.
2. In order to create the event code in the worksheet, you must allow the vbe project module to be "trusted"
Excel Options / Trust Center / Trust Center Settings / Macro Settings / Select "Trust access to the VBA project object model"
This probably only needs to be selected when creating the Summary worksheet. If you distribute workbooks with the Summary worksheet already present, after we have things up and running, that option probably will not need to be checked, as the event code should already be there.


Since these are getting kind of long, I will post links to where they are in Skydrive. You should be able to download them. If not, I'll post here in full.

RonCompareData: http://sdrv.ms/YXntiR
RonSummary: http://sdrv.ms/Wq4An2

Download the files; then open your workbook with the PanelData, DeviceType worksheets.
Open the VBEditor. Ensure your project is highlighted; then select File/Import and import these .bas files.

Let me know.

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

On Tue, 26 Feb 2013 21:56:38 -0500, Ron Rosenfeld wrote:

On Mon, 25 Feb 2013 23:23:20 +0000, TimLeonard wrote:


Sorry for the delayed responce


SNIPPED

Here are some updated macros to try out.

You should install them in separate modules.

The first is to create the compare sheet, but it also has some universally used constants defined or declared.

The second creates both the summary sheet, and also adds in event code for that sheet so as to enable the automatic updating of the Device Types column if an editable column is changed. The event code within that module is not easily understood, but after the sheet is created, you can see it by right clicking on the worksheet "Summary" tab, and viewing the code in the window that opens.

Some caveats:

1. Save the workbook in BINARY format (.xlsb). I will eventually get around to putting the dropdown on a separate worksheet, but haven't yet.
2. In order to create the event code in the worksheet, you must allow the vbe project module to be "trusted"
Excel Options / Trust Center / Trust Center Settings / Macro Settings / Select "Trust access to the VBA project object model"
This probably only needs to be selected when creating the Summary worksheet. If you distribute workbooks with the Summary worksheet already present, after we have things up and running, that option probably will not need to be checked, as the event code should already be there.


Since these are getting kind of long, I will post links to where they are in Skydrive. You should be able to download them. If not, I'll post here in full.

RonCompareData: http://sdrv.ms/YXntiR
RonSummary: http://sdrv.ms/Wq4An2

Download the files; then open your workbook with the PanelData, DeviceType worksheets.
Open the VBEditor. Ensure your project is highlighted; then select File/Import and import these .bas files.

Let me know.

OK, a few problems to be solved.

1. Setting the reference programmatically doesn't work as I thought it would. I have it fixed but, until I post a revised set of macros, you'll need to do it yourself.
From the top menu in the VBE, select Tools / References and check the entry for Microsoft Visual Basic for Applications Extensibility. You can leave the code alone, as it won't run if the reference is already checked.

2. After running the Summary sheet macro, the code window for the event code opens up. I want the Summary sheet to be what is seen, but that should be easily fixable, and not a problem at this time.

OK I have downloaded both macros and imported them

Ok I have done both of these

And I have done this....But it give the following complie error and wont run
"Ambiguous name detected: sTCL"

The following is the most commomly used items for the pulldown list...But there will be times when one of the others not shown could be used. Also if the comparedata sheet uses a different one then the one used from the pulldown list, then I think it should replace it during the compare process

Heat(Fixed)
Heat(Rate of Rise)
Smoke(Ion)
Smoke(Photo)
Smoke(Duct I)
Sup T(Duct I)
Smoke(Duct P)
Sup T(Duct P)
Control
Relay
Monitor
Pull Station
Waterflow
Tamper
Latch Superv
Track Superv
Sys Monitor
Non Fire
Power Monitr
Reset Switch
Trouble Mon
Abort Switch
Bell Circuit
Strobe Ckt
Horn Circuit
Audible Ckt

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

On Wed, 27 Feb 2013 04:40:12 +0000, TimLeonard wrote:



And I have done this....But it give the following complie error and wont
run
"Ambiguous name detected: sTCL"


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

Hmmm. I did not have that problem. It means the name has been declared (preceded by Dim or by Public) more than once.
Do you possibly have a module in the workbook containing a previous version of the CreateCompareDataSheet macro?

Yep had another copy... once removed it worked fine...

BTW I see that the pulldown also populates the device type column but if you prefer, we could populate the Device Type Column on both (CompareData and Summary) sheets since it will always be either a Device, Module or Zone there really isn't a reason to leave then blank...

Otherwise is seem to work great and the locked cells are good also...

I also like how the pull down looks...If possible we should try to keep all of them but if it does need to be reduced it could go as little as the post I made of them...

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

On Wed, 27 Feb 2013 04:40:12 +0000, TimLeonard wrote:

OK I have downloaded both macros and imported them

As I've been getting into the issue of automating the user adding nodes and loops to the Summary sheet, a question occurs:

You have already established that the Node Addresses may not necessarily be consecutive, nor filled. So that one could have
Node Loops
1 3
2 0
3 5

In which case we would populate CompareData (and Summary) with the full range of Merge Addresses for
Node Loop
1 1 2 3
3 1 2 3 4 5
(excluding Node 2)

This implies that the Loops are consecutively numbered. But I never confirmed with you that that was, indeed, the case.
If it is the case, we are all set. If it is not the case, then you should know that, as written, the code will populate the range of Merge Addresses up to the highest numbered loop. In other words, in the example above, even if the only loop being used in node 3 were loop 5, the range of Merge Addresses (and rows) populated would be the same.

If that is not your preference, let me know.

Yes this would be true...
However in the example Node 2 could be a panel that does not use the loops such as a remote annunciator or a voice panel...The engineer should know that the node address has been used so that they don't try to assign that number to a panel that does use the loops...

99% of the time the loops would be installed consecutive from 1 to 10 but there could be times when it would skip. The loops get installed in a manner where loops 1,3,5,7,9 would be the primary and loops 2,4,6,8,10 are the expanders. So it is possible to have six loops installed in the following manner 1,2,3,4,5,7 because loop 2 mounts on to of loop 1 and loop 4 mounts on top of loop 3 and loops 5 and 7 have no expanders. This example is a rare situation but it has happened.

The fact that it would create the spare mergedaddresses for loop 6 even though its not installed would require a work around but if is correctable then that would be even better...

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

On Thu, 28 Feb 2013 04:55:39 +0000, TimLeonard wrote:



You have already established that the Node Addresses may not necessarily
be consecutive, nor filled. So that one could have
Node Loops
1 3
2 0
3 5

In which case we would populate CompareData (and Summary) with the full
range of Merge Addresses for
Node Loop
1 1 2 3
3 1 2 3 4 5
(excluding Node 2)

Yes this would be true...
However in the example Node 2 could be a panel that does not use the
loops such as a remote annunciator or a voice panel...The engineer
should know that the node address has been used so that they don't try
to assign that number to a panel that does use the loops...

HOW can the program know that Node 2 is being used if there are no loops selected?



99% of the time the loops would be installed consecutive from 1 to 10
but there could be times when it would skip. The loops get installed
in a manner where loops 1,3,5,7,9 would be the primary and loops
2,4,6,8,10 are the expanders. So it is possible to have six loops
installed in the following manner 1,2,3,4,5,7 because loop 2 mounts on
to of loop 1 and loop 4 mounts on top of loop 3 and loops 5 and 7 have
no expanders. This example is a rare situation but it has happened.

The fact that it would create the spare mergedaddresses for loop 6 even
though its not installed would require a work around but if is
correctable then that would be even better...


This can be done.

Did you solve the problem of the ambiguous name?

THere are a few ways nodes can be present with no loops for example

--A Voice panel, this one gets programmed using only zones...
--A Remote Annunciator is a node that is only to display what the panel displays, but it would be located at the main entrance of a building for the fire department to see the status of the main panel as they enter the building.
--A computer workstation that is used to show the status of the system on a computer with graphics is a node
--And there are cards that can page or email when a device is in alarm or trouble that is considered a node...All of these have no loops.

As far as how the system knows...It just complies all the node information down the list on the PanelData spreadsheet. I know on the voice panel it just shows the node number and uses zeros for the loop and has the zones Z000-Z999. I will need to double check how the others that I mentioned are shown and if they capture the zones....I will post this later as I will have to download it to find the answer

Yes i did, there was two macros with the same name

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

On Thu, 28 Feb 2013 04:55:39 +0000, TimLeonard wrote:

99% of the time the loops would be installed consecutive from 1 to 10
but there could be times when it would skip. The loops get installed
in a manner where loops 1,3,5,7,9 would be the primary and loops
2,4,6,8,10 are the expanders. So it is possible to have six loops
installed in the following manner 1,2,3,4,5,7 because loop 2 mounts on
to of loop 1 and loop 4 mounts on top of loop 3 and loops 5 and 7 have
no expanders. This example is a rare situation but it has happened.

The fact that it would create the spare mergedaddresses for loop 6 even
though its not installed would require a work around but if is
correctable then that would be even better...

Tim:

Here is a link to code that should correct this issue. I changed the GenLoops macro (and the argument passed to it) and it should ignore (not create merged addresses) for any zones that do not exist in Panel data (including Zone 0)
http://sdrv.ms/WuVYvI

There are now three modules. And some of the code has been moved around or otherwise "cleaned up".

You may note an "Add Loops" macro. I am starting to deal with the problem of the engineer selecting to add a loop or a node. But I think the choice complexities will require the use of User Forms in order to clearly allow the various choices that might be made.

I still have not gotten around to moving the dropdown box list to a worksheet. But, when we do so, it will be fairly simple to have one list that has the ten or fifteen most common options, and an option in that list which would select a longer list.

Ron

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

On Fri, 1 Mar 2013 02:58:53 +0000, TimLeonard wrote:



HOW can the program know that Node 2 is being used if there are no loops
selected?
THere are a few ways nodes can be present with no loops for example

--A Voice panel, this one gets programmed using only zones...
--A Remote Annunciator is a node that is only to display what the panel
displays, but it would be located at the main entrance of a building for
the fire department to see the status of the main panel as they enter
the building.
--A computer workstation that is used to show the status of the system
on a computer with graphics is a node
--And there are cards that can page or email when a device is in alarm
or trouble that is considered a node...All of these have no loops.

As far as how the system knows...It just complies all the node
information down the list on the PanelData spreadsheet. I know on the
voice panel it just shows the node number and uses zeros for the loop
and has the zones Z000-Z999. I will need to double check how the others
that I mentioned are shown and if they capture the zones....I will post
this later as I will have to download it to find the answer

Did you solve the problem of the ambiguous name?
Yes i did, there was two macros with the same name



Hopefully, if a Node is programmed with no loops, on the PanelData sheet the node will be listed with a Loop Selection of zero (0). That is easy to take into account.

I may have mentioned this before, but my idea with regard to the engineer adding nodes and/or loops to the Summary sheet would be to
What node do you want to add/modify: ___ (check that it is in range of acceptable numbers)
Present a box that allows information about any existing nodes and number of assigned addresses; as well as the opportunity to select unused loops to be added to the worksheet.
Then just add the 159*2 device rows plus 1000 zone rows to the Summary worksheet for that particular Node Address.

By the way, as I am getting into the comparison routines, it occurs to me that retaining this tight control over the format of the worksheets really helps with devising a routine to check on duplicates. For one thing, there is no way for an engineer to duplicate a "merged address". I'm thinking that in the final product, not only should the Summary sheet be locked (as we have it), but the locking should be password protected. In addition, the other sheets should also be locked and protected.