On Sun, 10 Feb 2013 19:43:27 +0000, TimLeonard wrote:

At this point I think the second workbook, as slow as it is and from
piecing various codes together, works through all we have discussed
except when adding missing addresses... But in some cases, it does not
complete to address 001 but would stop at address 005.

The following code starts with Worksheet "PanelData" as presented in your most recent workbook, and constructs a CompareData worksheet which, in order to not conflict, I have named "CompareData2".

I am trying to see if I am on the right track. This macro runs (on my machine), in less than one second.

It adds in all of the missing merged addresses.
It presents the columns in the same order that you have on your CompareData sheet.

It does NOT include lines that do not compute to a valid Merged Address code. (That can be changed if you like, but you'll need to define how to handle them).
It does NOT fill in the Node Address, LoopSelection, DeviceAddress fields at this time, but that can be easily changed if I am on the right track.

What do you think?

=============================================
Option Explicit
Sub CreateCompareDataSheet()
'Do this on a CompareData2 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 wsCompareData2 As Worksheet
Dim wsPD As Worksheet, vPD As Variant 'Panel Data
Dim r As Range

Dim LScol As Long 'Loop Selection column
Dim DTPcol As Long 'Device Type column
Dim sDTP As String
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 DTPScol As Long 'Device Types column

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

Set wsPD = Worksheets("PanelData")

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

'Read Panel Data into array
'Assuming zero(0) blanks in Col A
'Assume we will retain only cols A:H
With wsPD
vPD = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) _
.Offset(columnoffset:=2).Resize(columnsize:=6)
End With

'Add column for merged address
'For now, it will be the "last column", but could be moved if desired
ReDim Preserve vPD(1 To UBound(vPD, 1), 1 To UBound(vPD, 2) + 2)
MAcol = UBound(vPD, 2) - 1
DTPScol = UBound(vPD, 2)
vPD(1, MAcol) = "Merged Address"
vPD(1, DTPScol) = "Device Types"

'Get column numbers for data to create MergedAddress
ReDim aTemp(1 To UBound(vPD, 2))
For i = 1 To UBound(vPD, 2)
aTemp(i) = vPD(1, i)
Next i
With WorksheetFunction
LScol = .Match("LoopSelection", aTemp, 0)
DTPcol = .Match("DeviceType", aTemp, 0)
DAcol = .Match("DeviceAddress", aTemp, 0)
End With

'Create Merged Addresses
'Add Device Types Field
Set collUsedMA = New Collection
For i = 2 To UBound(vPD, 1)
Select Case vPD(i, DTPcol)
Case Is = 1
sDTP = "D"
vPD(i, DTPScol) = "Detector"
Case Is = 2
sDTP = "M"
vPD(i, DTPScol) = "Monitor"
Case Is = 3
sDTP = ""
vPD(i, DTPScol) = "Zone"
Case Else
sDTP = ""
End Select
If Not sDTP = "" Then
vPD(i, MAcol) = "L" & Format(vPD(i, LScol), "00") & _
sDTP & _
Format(vPD(i, DAcol), "000")
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
With WorksheetFunction
LScol = .Match("LoopSelection", wsPD.Rows(1), 0)
v = GenLoops(.Max(wsPD.Columns(LScol)))
End With

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

'write array to CompareData2 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 8) 'custom list array
aCL(1) = "NodeAddress"
aCL(2) = "LoopSelection"
aCL(3) = "DeviceAddress"
aCL(4) = "Merged Address"
aCL(5) = "DeviceType"
aCL(6) = "Device Types"
aCL(7) = "DeviceLabel"
aCL(8) = "ExtendedLabel"
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

'Write data to CompareData2 sheet
Application.ScreenUpdating = False
With wsCompareData2
Set r = .Range("B1", .Cells(UBound(vPD, 1), UBound(vPD, 2) + 1))
r = vPD

'Add the Missing Merged Addresses to the correct column
ReDim aTemp(1 To collMissMA.Count, 1 To 1)
For i = 1 To collMissMA.Count
aTemp(i, 1) = collMissMA(i)
Next i
MAcol = WorksheetFunction.Match("Merged Address", .Rows(1), 0)
Set r = .Range(Cells(r.Row + r.Rows.Count, MAcol), _
Cells(r.Rows.Count + UBound(aTemp, 1), MAcol))
r = aTemp
'Sort by Merged Address and delete those with blank MA's
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range(.Cells(.UsedRange.Row + 1, MAcol), _
.Cells(.UsedRange.Row + .UsedRange.Rows.Count, MAcol)), _
SortOn:=xlsortonxlvalues, Order:=xlAscending
With .Sort
.SetRange wsCompareData2.UsedRange
.Header = xlYes
.Orientation = xlTopToBottom
.Apply
End With
Set r = .Cells(.Cells.Rows.Count, MAcol).End(xlUp).Offset(1)
Set r = Range(r, r.End(xlDown))
r.EntireRow.Delete

'Now sort horizontally to reorder the columns
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("B1", .Cells(1, .Columns.Count).End(xlToLeft)), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
CustomOrder:=Join(aCL, ",")
With .Sort
.SetRange wsCompareData2.UsedRange
.Header = xlYes
.Orientation = xlLeftToRight
.Apply
End With
..UsedRange.EntireColumn.AutoFit
End With

Application.ScreenUpdating = True
End Sub

'-------------------------------------------------------
Function GenLoops(NumLoops) As Variant
'Part 1: L01-L10
'Part 2: D or M
'Part 3: 001-159
Dim MergAddr() As String
Dim i As Long, j As Long, k As Long, m As Long
ReDim MergAddr(1 To NumLoops * 2 * 159)

For i = 1 To NumLoops
For j = 1 To 2
For k = 1 To 159
m = m + 1
MergAddr(m) = "L" & Format(i, "00") & _
IIf(j = 1, "D", "M") & _
Format(k, "000")
Next k
Next j
Next i
GenLoops = MergAddr
End Function
===========================================