double loop madness - help with macro

[Nicole Seibert]

Alright. This bit of code is not working. I should note that the NewProject
and Compare values are a variable of two letters followed by numbers. I am
trying to match these and then notify the user by marking the cells red. I
think there may a problem with the double loop, but I can't tell.
I get red cells. I even get looping. In reality the contents of the cells
are two different numbers even though the msgbox that you see below gives the
cell contents as identical and the cell position correctly.

Dim NC1 As Integer
Dim NewProject As Variant
Dim Compare As Variant
Dim LC1 As Integer
Dim i As Integer
Dim j As Integer

Windows(NameWorksheet & ".xls").Activate
Sheets("Estimated - BA Approved").Select
NC1 = Cells(Rows.Count, 1).End(xlUp).Row
If NC1 = 2 Then
MsgBox ("There are no projects on this page.")
GoTo STOP1
Else
Windows(NameWorksheet & ".xls").Activate
Sheets("Estimated - BA Approved").Select
For i = 3 To NC1
NewProject = Range("A" & i).Value
Windows(OldWorksheet & ".xls").Activate
Sheets("Estimated - BA Approved").Select
LC1 = Cells(Rows.Count, 1).End(xlUp).Row
For j = 3 To LC1
Compare = Range("A" & j).Value
If NewProject = Compare Then
Range("A" & j).Interior.Color = RGB(255, 0, 0)
Windows(NameWorksheet & ".xls").Activate
Sheets("NOT Estimated - BA NOT Approved").Select
Range("A" & i).Interior.Color = RGB(255, 0, 0)
MsgBox ("This project, " & NewProject & ", A" & i & "
has been found in the old project list" & Compare & " , A" & j & ". The cell
in the old project list is colored red. Please fix this problem and run this
program again. This program finds one duplicate project at a time.")
Exit Sub
Else
End If
Next j
Next i
End If

 

[Greg Wilson]

Nicole,

My read in a nutshell is that you have two workbooks (wbs) that likely
contain project names. Both wbs have a worksheet named "Estimated - BA
Approved" and the project names (if any) are contained in these worksheets.
For both worksheets, the project names start in cell A3 if they exist.

If either worksheet doesn't have any project names then you want to abort
the macro. Else, you want to look for duplication of project names between
the wbs. If and where found, you want to colour the cells containing
duplicates red for both wbs.

If the above interpretation is correct, then I think the following macro is
what you want. Note that it will require adaption to your situation but (I
think) is mechanically correct. It is much simpler than what you were doing.

Written in a hurry, very little testing and based on a cursory
interpretation:-

Sub XYZ()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim r1 As Range, r2 As Range
Dim c As Range
Dim DupsFound As Boolean
Dim MsgNum As Integer

DupsFound = False
Set ws1 = Workbooks("Test1.xls").Sheets("Sheet1")
Set ws2 = Workbooks("Test2.xls").Sheets("Sheet1")
Set r1 = ws1.Range(ws1.Cells(3, 1), ws1.Cells(3, 1).End(xlDown))
Set r2 = ws2.Range(ws2.Cells(3, 1), ws2.Cells(3, 1).End(xlDown))

If IsEmpty(r1(1, 1)) Or IsEmpty(r2(1, 1)) Then
MsgNum = 1
GoTo ProcExit
End If

For Each c In r1.Cells
If Application.CountIf(r2, c.Value) > 0 Then
DupsFound = True
c.Interior.ColorIndex = 3
End If
Next
For Each c In r2.Cells
If Application.CountIf(r1, c.Value) > 0 Then _
c.Interior.ColorIndex = 3
Next

MsgNum = IIf(DupsFound, 2, 3)
ProcExit:
Call MsgText(MsgNum)
End Sub

Private Sub MsgText(MsgNum As Integer)
Dim msg As String, title As String
Dim style As Integer

title = "Project name duplication check"
Select Case MsgNum
Case 1
msg = "Blank project names list found !!! "
style = vbExclamation
Case 2
msg = "Project duplication between workbooks found !!! "
style = vbExclamation
Case 3
msg = "No duplicate project names found "
style = vbInformation
End Select
MsgBox msg, style, title
End Sub


Regards,
Greg