Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 60
Default double loop madness - help with macro

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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 747
Default double loop madness - help with macro

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
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Sorting Madness JSnow Excel Discussion (Misc queries) 5 February 11th 09 05:52 PM
Formula Madness IoHeFy Excel Discussion (Misc queries) 2 January 4th 07 01:16 PM
Multimodal Madness Rothman Excel Worksheet Functions 0 March 16th 06 12:56 AM
VBA Names madness Jag Man Excel Programming 2 December 30th 03 12:57 AM
More Macro Madness Josh in Tampa Excel Programming 5 October 24th 03 11:14 PM


All times are GMT +1. The time now is 12:30 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"