Comparing Named Ranges

[Imaginativeone]

My Function "FindMoves" (in red) creates two sets of 129 rows of named ranges. One of these range-sets resides on Sheet1 and the other on Sheet2. Is there a way that I can compare the named ranges on the respective sheets?

Thanks

Option Explicit
Private Sub cmdCompare_Click()
Dim excelApp
Set excelApp = CreateObject("Excel.Application")

UseMatchFunction excelApp
FindAddsNDrops excelApp

FindMoves excelApp, "Sheet1", "Sheet2"

End Sub
Function UseMatchFunction(excelApp)
Application.ScreenUpdating = False
' Dim wordApp
' Set wordApp = CreateObject("Word.Application")
' wordApp.Visible = True
' wordApp.Documents.Add
excelApp.Visible = True
excelApp.Workbooks.Add

Dim pWorkbook As Workbook
Dim pWorksheet As Worksheet
Dim pTabName As String: pTabName = "OASDI 2007"
Dim pListColumn As Range
Dim pListColumnVolume As Integer
Set pWorkbook = ActiveWorkbook
Set pWorksheet = pWorkbook.Sheets(pTabName)
Set pListColumn = pWorksheet.Range("A1").SpecialCells(xlCellTypeLastCell)
pListColumnVolume = pListColumn.row
Dim pCellPosValue As New DynamicArray
Dim pCellLocation
Dim pCellContents
Dim pCellFunction
Dim pCellAddress
Dim pListInputRowIndex: pListInputRowIndex = 6
Dim pListOutputRowIndex: pListOutputRowIndex = 2
' Dim pListOutputColIndex: pListOutputColIndex = -1
Dim pListOutputColIndex: pListOutputColIndex = 0

' ////////////////////////////////////////////////////////////////////////////////////
Do Until pListInputRowIndex > pListColumnVolume
Set pCellLocation = pWorksheet.Cells(pListInputRowIndex, 1)
pCellContents = pWorksheet.Cells(pListInputRowIndex, 1).Value
If Not IsNumeric(pCellContents) Then
pListOutputColIndex = pListOutputColIndex + 1
' pListOutputColIndex = pListOutputColIndex + 2
pListOutputRowIndex = 2
excelApp.Cells(pListOutputColIndex, 1).Value = pCellContents
Else
excelApp.Cells(pListOutputColIndex, pListOutputRowIndex).Value = pCellContents
pListOutputRowIndex = pListOutputRowIndex + 1
End If
pListInputRowIndex = pListInputRowIndex + 1
Loop
' ////////////////////////////////////////////////////////////////////////////////////
excelApp.Sheets("Sheet2").Select
Dim cWorkbook As Workbook
Dim cWorksheet As Worksheet
Dim cTabName As String: cTabName = "OASDI 2008"

Dim cListColumn As Range
Dim cListColumnVolume As Integer

Set cWorkbook = ActiveWorkbook
Set cWorksheet = cWorkbook.Sheets(cTabName)

Set cListColumn = cWorksheet.Range("A1").SpecialCells(xlCellTypeLastCell)
cListColumnVolume = cListColumn.row

Dim cCellPosValue As New DynamicArray
Dim cCellLocation
Dim cCellContents
Dim cCellFunction
Dim cCellAddress
Dim cListInputRowIndex: cListInputRowIndex = 6
Dim cListOutputRowIndex: cListOutputRowIndex = 2

Dim cListOutputColIndex: cListOutputColIndex = 0

' ////////////////////////////////////////////////////////////////////////////////////
Do Until cListInputRowIndex > cListColumnVolume

Set cCellLocation = cWorksheet.Cells(cListInputRowIndex, 1)
cCellContents = cWorksheet.Cells(cListInputRowIndex, 1).Value

If Not IsNumeric(cCellContents) Then
cListOutputColIndex = cListOutputColIndex + 1
' cListOutputColIndex = cListOutputColIndex + 2
cListOutputRowIndex = 2
excelApp.Cells(cListOutputColIndex, 1).Value = cCellContents
Else
excelApp.Cells(cListOutputColIndex, cListOutputRowIndex).Value = cCellContents
cListOutputRowIndex = cListOutputRowIndex + 1
End If

cListInputRowIndex = cListInputRowIndex + 1

Loop
' ////////////////////////////////////////////////////////////////////////////////////
End Function
Sub FindAddsNDrops(excelApp)
Dim rng1 As Range
Dim rng2 As Range
Dim cell As Range
Dim c As Range
Dim rng As Range

' Set rng1 = Sheets(1).UsedRange
' Set rng2 = Sheets(2).UsedRange
Set rng1 = excelApp.Sheets(1).UsedRange
Set rng2 = excelApp.Sheets(2).UsedRange

' Adds and Drops (moves are in a different function)
For Each cell In rng1
If cell <> "" Then
Set c = rng2.Find(cell, lookat:=xlWhole)
If c Is Nothing Then
cell.Interior.ColorIndex = 3
End If
End If
Next cell

For Each cell In rng2
If cell <> "" Then
Set c = rng1.Find(cell, lookat:=xlWhole)
If c Is Nothing Then
cell.Interior.ColorIndex = 3
End If
End If
Next cell

End Sub

Function FindMoves(excelApp, pTabName, cTabName)
excelApp.Worksheets(pTabName).Select

Dim used_Rows, rowVolume
Set used_Rows = excelApp.Sheets(pTabName).Range("A1").SpecialCells(xlCellTypeLastCell)
rowVolume = used_Rows.row

Dim pRangeNameArray As New DynamicArray
Dim comparisonRange As Range
Dim cleanedName

Dim r
For r = 1 To rowVolume

Set comparisonRange = excelApp.Range(excelApp.Cells(r, 1), excelApp.Cells(r, 1).End(xlToRight))

cleanedName = excelApp.Cells(r, 1).Value & "_2008"
cleanedName = Replace(cleanedName, " ", "_")
cleanedName = Replace(cleanedName, ",", "_")
cleanedName = Replace(cleanedName, ".", "_")
cleanedName = Replace(cleanedName, " ", "_")
cleanedName = Replace(cleanedName, "__", "_")

comparisonRange.Name = cleanedName
comparisonRange.Select

pRangeNameArray.Data(r) = cleanedName

Next
excelApp.Worksheets(cTabName).Select

' Dim used_Rows, rowVolume
Set used_Rows = excelApp.Sheets(cTabName).Range("A1").SpecialCells(xlCellTypeLastCell)
rowVolume = used_Rows.row

Dim cRangeNameArray As New DynamicArray
' Dim comparisonRange As Range
' Dim cleanedName

' Dim r
For r = 1 To rowVolume

Set comparisonRange = excelApp.Range(excelApp.Cells(r, 1), excelApp.Cells(r, 1).End(xlToRight))

cleanedName = excelApp.Cells(r, 1).Value & "_2008"
cleanedName = Replace(cleanedName, " ", "_")
cleanedName = Replace(cleanedName, ",", "_")
cleanedName = Replace(cleanedName, ".", "_")
cleanedName = Replace(cleanedName, " ", "_")
cleanedName = Replace(cleanedName, "__", "_")

comparisonRange.Name = cleanedName
comparisonRange.Select

cRangeNameArray.Data(r) = cleanedName

Next

MsgBox UBound(pRangeNameArray.DataArray)
MsgBox UBound(cRangeNameArray.DataArray)

End Function

Function LastInRow(rng As Range)
Application.Volatile

With rng.Parent

With .Cells(rng.row, .Columns.Count)

If Not IsEmpty(.Value) Then
LastInRow = .Value
ElseIf IsEmpty(.End(xlToLeft)) Then
LastInRow = ""
Else
LastInRow = .End(xlToLeft).Value
End If

End With

End With
End Function
Function CompareMoves(pRows, cRows)
End Function
' pCellPosValue.Data(pListRowIndex) = Excel.WorksheetFunction.Match(pCellContents, [A:A], 0)
Private Sub UserForm_Click()
End Sub