Tuesday, 18 December 2007

It's really basic but surprisingly fun

Sub BoldDups_TwoLists()
    Dim iListCount As Integer
    Dim iCtr As Integer
    ' Turn off screen updating to speed up macro.
    Application.ScreenUpdating = False
    ' Get count of records to search through (list that will be made bold).
    iListCount = Sheets("NEW RBS").Range("D7:D3030").Rows.Count
    ' Loop through the "master" list.
    For Each x In Sheets("Payments Recieved").Range("A1:A931")
        For iCtr = 7 To iListCount
            ' Loop through all the cells in the 'D' column (Row 4)
            If x.Value = Sheets("NEW RBS").Cells(iCtr, 4).Value Then
                ' We have a match. Make the cell bold
                Sheets("NEW RBS").Cells(iCtr, 1).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 2).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 3).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 4).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 5).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 6).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 7).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 8).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 9).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 10).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 11).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 12).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 13).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 14).Font.Bold = True
                Sheets("NEW RBS").Cells(iCtr, 15).Font.Bold = True
                Exit For
                ' The Cells don't match
            End If
        Next iCtr
    Application.ScreenUpdating = True
    MsgBox "Done!"

NOTICE - This e-mail and its attachments are strictly confidential. If you are not the intended recipient please delete the e-mail (including attachments) from your system without printing copying disclosing or otherwise using its contents. If you have received this e-mail in error please notify the sender immediately by e-mail or telephone 0845 155 2999. Any e-mails sent in an employee's personal capacity are not sent on behalf of the sender's employer and are the personal responsibility of the sender. Any views or opinions expressed in this email are those of the author only

WARNING - Data conveyed by e-mail could be deliberately or accidentally intercepted or corrupted. The company does not accept any responsibility for any changes or breaches of confidence which may arise through use of this medium. The content of e-mails sent and received by company employees may be intercepted or monitored by the company. It is the responsibility of the recipient to ensure that this e-mail has not been tampered with and that any attachments are virus-free. Whilst we make every effort to ensure that this e-mail is free from viruses this cannot be guaranteed. We recommend that you scan all e-mail for viruses with appropriate and frequently updated virus checking software

Homeserve Emergency Services Limited     Registered Office: Cable Drive Walsall WS2 7BN.     VAT Registration No: 559669669      Registered in England No: 1484358        

It takes 24 trees to produce 1 ton of office paper! Think� is it really necessary to print this email?

1 comment:

Phil said...

nice macro! It reminds me of college lunch times writing assembler code....truely sad!