formating macro based on criteria

alvbnp

Board Regular
Joined
Jun 26, 2006
Messages
180
I have column B which filled in with number in ascending sorted. But this list might have number that are the same. Is it possible to have a macro to find the same number then add border into it?

eg:
b1 = 11
b2 = 12
b3 = 13
b4 = 13
b5 = 14
b6 = 15
b7 = 15
b8 = 15
b9 = 16

from the sample above, b3 & b4 are same, put border from b3 to h4. so that it highlight the whole thing. same as for b6 to h8.

besides that, also need to put autosum c3:c4 in h4, autosum c6:c8 in h8.

Thanks.
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,884
Hi alvbnp

To format the duplicates you don't need a macro, use Conditional Formatting.

Select B1:B9
Format>Conditional Formatting, in Condition 1 choose Formula Is and enter the formula

=COUNTIF($B:$B,B1)>1

Then click on the Format button and choose the colour for the background.

Hope this helps
PGC
 

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,884
Hi again

Just saw that you also want the autosum

In H1:

Code:
=IF(COUNTIF($B$1:$B$9,B1)=1,"",IF(COUNTIF(B1:$B$9,B1)=1,SUMIF($B$1:$B$9,B1),""))
Copy down

Kind regards
PGC
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Try this macro:

Code:
Sub Test()
    Dim Rng As Range
    Dim Cell As Range
    Dim List As New Collection
    Dim Item As Variant
    Dim Rng1 As Range
    Application.ScreenUpdating = False
    With Worksheets("Sheet1")
        Set Rng = .Range("B1:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
        Rng.Resize(Rng.Rows.Count, 7).Borders.LineStyle = xlLineStyleNone
        For Each Cell In Rng
            On Error Resume Next
            List.Add Cell.Value, Format(Cell.Value, Cell.NumberFormat)
        Next Cell
        On Error GoTo 0
        .Rows(1).EntireRow.Insert
        .Cells(1, 2).Value = "List"
        Set Rng = .Range("B1:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
        For Each Item In List
            Rng.AutoFilter
            Rng.AutoFilter Field:=1, Criteria1:=Item
            Set Rng1 = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 7)
            Set Rng1 = Rng1.SpecialCells(xlCellTypeVisible)
            With Rng1
            If .Rows.Count > 1 Then
                .BorderAround xlContinuous
                .Cells(.Rows.Count, .Columns.Count).Formula = "=SUM(" & .Columns(1).Address(False, False) & ")"
            End If
            End With
        Next Item
        .AutoFilterMode = False
        .Rows(1).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
End Sub
 

Forum statistics

Threads
1,140,941
Messages
5,703,292
Members
421,290
Latest member
java

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top