Closed Thread
Results 1 to 2 of 2

double loop madness - help with macro

  1. #1
    Nicole Seibert
    Guest

    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. #2
    Greg Wilson
    Guest

    RE: 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

Closed Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1