[VBA, FOSS] 2MapsComparer

'#Language "WWB-COM"

Option Explicit

Function InputBoxInteger(Prompt As String, Title As String) As Variant
Dim userInput As String
Dim validInput As Boolean
Dim intValue As Integer

validInput = False

Do While Not validInput
userInput = InputBox(Prompt, Title)

If userInput = "" Then
InputBoxInteger = Null
Exit Function
End If

On Error Resume Next
intValue = CInt(userInput)
If Err.Number = 0 Then
validInput = True
Else
MsgBox "Please enter a valid integer.", vbExclamation, "Invalid Input"
Err.Clear
End If
On Error GoTo 0
Loop

InputBoxInteger = intValue
End Function

Function InputBoxCriterion(Prompt As String, Title As String) As Boolean
Dim userInput As String

Do
userInput = InputBox(Prompt & vbCrLf & "Enter 1 for Yes, 2 for No:", Title)

If userInput = "" Then
InputBoxCriterion = False
Exit Function
ElseIf userInput = "1" Then
InputBoxCriterion = True
Exit Function
ElseIf userInput = "2" Then
InputBoxCriterion = False
Exit Function
End If
Loop
End Function

Sub Main

Dim LtMap As Document
Dim RtMap As Document
Dim LtMapSelectedTopics
Dim RtMapSelectedTopics
Dim Topic As Topic
Dim targetTopic As Topic
Dim found As Boolean
Dim docList As String
Dim index As Integer
Dim choice1 As Integer
Dim choice2 As Integer
Dim compareText As Boolean
Dim compareNotes As Boolean
Dim compareParentTopic As Boolean

' Check if there are at least two documents open
If Documents.Count >= 2 Then
' List all opened documents
docList = "Opened Documents:" & vbCrLf
For index = 1 To Documents.Count
docList = docList & index & ". " & Documents.Item(index).Name & vbCrLf
Next index

' Ask the user to choose the LtMap and RtMap
Do
choice1 = InputBoxInteger(docList & vbCrLf & "Enter the number of the document you want to set as LtMap:", "Choose LtMap")
Loop While IsNull(choice1) Or choice1 <= 0 Or choice1 > Documents.Count

Do
choice2 = InputBoxInteger(docList & vbCrLf & "Enter the number of the document you want to set as RtMap:", "Choose RtMap")
Loop While IsNull(choice2) Or choice2 <= 0 Or choice2 > Documents.Count Or choice2 = choice1

' Access the chosen documents
Set LtMap = Documents.Item(choice1)
Set RtMap = Documents.Item(choice2)

Else
MsgBox "Please ensure that at least two documents are open."
Exit Sub
End If

' Collect the selected topics in the LtMap
Set LtMapSelectedTopics = LtMap.Selection

' Collect the selected topics in the RtMap
Set RtMapSelectedTopics = RtMap.Selection

' Ask the user to choose the comparison criteria
compareText = InputBoxCriterion("Compare Text?" & vbCrLf, "Comparison Criteria")
compareNotes = InputBoxCriterion("Compare Notes?" & vbCrLf, "Comparison Criteria")
compareParentTopic = InputBoxCriterion("Compare ParentTopic?" & vbCrLf, "Comparison Criteria")

' Iterate through the selected topics in the LtMap and compare them to the selected topics in the RtMap
For Each Topic In LtMapSelectedTopics
found = False
Dim criteriaString As String
criteriaString = ""

For Each targetTopic In RtMapSelectedTopics
If (Not compareText Or (compareText And Topic.Text = targetTopic.Text)) And _
(Not compareNotes Or (compareNotes And Topic.Notes.Text = targetTopic.Notes.Text)) And _
(Not compareParentTopic Or (compareParentTopic And Topic.ParentTopic.Text = targetTopic.ParentTopic.Text)) Then
found = True
If compareText And Topic.Text = targetTopic.Text Then criteriaString = criteriaString & "T"
If compareNotes And Topic.Notes.Text = targetTopic.Notes.Text Then criteriaString = criteriaString & "N"
If compareParentTopic And Topic.ParentTopic.Text = targetTopic.ParentTopic.Text Then criteriaString = criteriaString & "P"
Exit For
End If
Next targetTopic

If found Then
Topic.TextLabels.AddTextLabel("Found (" & criteriaString & ")")
Else
Topic.TextLabels.AddTextLabel("NotFound")
End If
Next Topic

End Sub