VBA to find doubles in lines whatever the order is but depending on 2 criteria

jbesclapez

jbesclapez

Active Member
Joined
Feb 6, 2010
Messages
275
Hello Mr Excel,

I have this first table
CriteriaACriteriaBCriteriaCCriteriaDCriteriaECriteriaFCriteriaGfamilytown
abcfamilyAtownB
cbafamilyAtownB
bcafamilyAtownB
defghfamilyBTownC
hefgdfamilyBTownC
defghfamilyBTownD
hefgdfamilyBTownD
bcfamilyAtownB
cafamilyAtownB

<tbody>
</tbody>


And I expect a result like this :
CriteriaACriteriaBCriteriaCCriteriaDCriteriaECriteriaFCriteriaGfamilytown
abcfamilyAtownB
defghfamilyBTownC
hefgdfamilyBTownD
bcfamilyAtownB
cafamilyAtownB

<tbody>
</tbody>

From column A to G you have the criteria that needs to be "simplified" depending on the family AND town.

Here are the explanations:
- a "group" is based on a family AND town.
- The order of the criteria is non relevant, so A and B is the same than B and A. That explains why I can simply the 3 first lines of the first table into only 1 line in the second one.
- The town last row of the first table can NOT be simplified. But I "expect" the empty fields to be moved to the left in order to have only empty fields after the data. This only helps to have a more "readable" table.

I hope I am clear enough and that you can help me to do this VBA.

Thanks for taking time to answer me.
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Sort by date Sort by votes
Try this for results on sheet2.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG06Oct33
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] a [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, Sp [COLOR="Navy"]As[/COLOR] Variant, Sp1 [COLOR="Navy"]As[/COLOR] Variant, Sp2 [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Txt = ""
    ReDim nray(1 To 7)
        [COLOR="Navy"]For[/COLOR] ac = 0 To 6
            [COLOR="Navy"]If[/COLOR] Not IsEmpty(Dn.Offset(, ac).Value) [COLOR="Navy"]Then[/COLOR]
                a = a + 1
                nray(a) = Dn.Offset(, ac).Value
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] ac
ReDim Preserve nray(1 To a): a = 0: Txt = nSort(nray)
Txt = Txt & "_" & Dn.Offset(, 7).Value & "," & Dn.Offset(, 8).Value
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Txt) [COLOR="Navy"]Then[/COLOR]
        Dic.Add Txt, Nothing
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
ReDim Ray(1 To Rng.Count + 1, 1 To 9)
    [COLOR="Navy"]For[/COLOR] n = 1 To 9
        Ray(1, n) = Rng(1).Offset(-1, n - 1).Value
    [COLOR="Navy"]Next[/COLOR] n
    c = 1
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
            c = c + 1
            Sp = Split(K, "_")
            Sp1 = Split(Sp(0), ",")
                [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp1)
                    Ray(c, n + 1) = Sp1(n)
                [COLOR="Navy"]Next[/COLOR] n
                Sp2 = Split(Sp(1), ",")
                Ray(c, 8) = Sp2(0): Ray(c, 9) = Sp2(1)
        [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]With[/COLOR] Sheets("sheet2").Range("A1").Resize(UBound(Ray, 1), 9)
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]


Function nSort(Ray [COLOR="Navy"]As[/COLOR] Variant) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] J, i, Temp
[COLOR="Navy"]For[/COLOR] i = 1 To UBound(Ray)
    [COLOR="Navy"]For[/COLOR] J = i To UBound(Ray)
        [COLOR="Navy"]If[/COLOR] Ray(J) < Ray(i) [COLOR="Navy"]Then[/COLOR]
            Temp = Ray(i)
            Ray(i) = Ray(J)
            Ray(J) = Temp
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] J
[COLOR="Navy"]Next[/COLOR] i
nSort = Join(Ray, ",")
[COLOR="Navy"]End[/COLOR] Function
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this for results on sheet2.
Code: 
[COLOR=Navy]Sub[/COLOR] MG06Oct33
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Txt [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] K [COLOR=Navy]As[/COLOR] Variant, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] a [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object, Sp [COLOR=Navy]As[/COLOR] Variant, Sp1 [COLOR=Navy]As[/COLOR] Variant, Sp2 [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    Txt = ""
    ReDim nray(1 To 7)
        [COLOR=Navy]For[/COLOR] ac = 0 To 6
            [COLOR=Navy]If[/COLOR] Not IsEmpty(Dn.Offset(, ac).Value) [COLOR=Navy]Then[/COLOR]
                a = a + 1
                nray(a) = Dn.Offset(, ac).Value
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]Next[/COLOR] ac
ReDim Preserve nray(1 To a): a = 0: Txt = nSort(nray)
Txt = Txt & "_" & Dn.Offset(, 7).Value & "," & Dn.Offset(, 8).Value
    [COLOR=Navy]If[/COLOR] Not Dic.Exists(Txt) [COLOR=Navy]Then[/COLOR]
        Dic.Add Txt, Nothing
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
ReDim Ray(1 To Rng.Count + 1, 1 To 9)
    [COLOR=Navy]For[/COLOR] n = 1 To 9
        Ray(1, n) = Rng(1).Offset(-1, n - 1).Value
    [COLOR=Navy]Next[/COLOR] n
    c = 1
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] Dic.keys
            c = c + 1
            Sp = Split(K, "_")
            Sp1 = Split(Sp(0), ",")
                [COLOR=Navy]For[/COLOR] n = 0 To UBound(Sp1)
                    Ray(c, n + 1) = Sp1(n)
                [COLOR=Navy]Next[/COLOR] n
                Sp2 = Split(Sp(1), ",")
                Ray(c, 8) = Sp2(0): Ray(c, 9) = Sp2(1)
        [COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]With[/COLOR] Sheets("sheet2").Range("A1").Resize(UBound(Ray, 1), 9)
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]


Function nSort(Ray [COLOR=Navy]As[/COLOR] Variant) [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] J, i, Temp
[COLOR=Navy]For[/COLOR] i = 1 To UBound(Ray)
    [COLOR=Navy]For[/COLOR] J = i To UBound(Ray)
        [COLOR=Navy]If[/COLOR] Ray(J) < Ray(i) [COLOR=Navy]Then[/COLOR]
            Temp = Ray(i)
            Ray(i) = Ray(J)
            Ray(J) = Temp
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] J
[COLOR=Navy]Next[/COLOR] i
nSort = Join(Ray, ",")
[COLOR=Navy]End[/COLOR] Function
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

Thanks Mike. I will give it a try and come back to you early next week.
Please would you mind following this up?
Thanks again and have a nice week end.
 
Upvote 0
MickG said:
You're welcome
I'll look for your follow up !!!
Click to expand...


Mick, it seems to be working like expected.
I like the fact that you "Alphabetized" the data... I did not think about that before.

Here is an alternative that a friend got me working :

Code: 
[COLOR=#008F00][FONT=Menlo]' This is a user-defined function that will alphabetize the cells,[/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo]' excluding those that are blank.[/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo]' If non-blank cells are duplicated, the function will return the text "Duplicated Cell"[/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo]' You may have as many as you like passed to the function.[/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo]'[/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo]' Use it with a formula like:[/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo]' =Alphabetize((F4,N4,V4,AD4),"/")[/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo]' The parentheses around the list of cells are important![/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo]' It is Public because it is not in the main module, otherwise it won't be usable in a worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Public[/COLOR] [COLOR=#011993]Function[/COLOR] Alphabetize(vStrings [COLOR=#011993]As[/COLOR] [COLOR=#011993]Variant[/COLOR], separator [COLOR=#011993]As[/COLOR] [COLOR=#011993]String[/COLOR]) [COLOR=#011993]As[/COLOR] [COLOR=#011993]String[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Dim v As Variant, vSorted As Variant[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Dim i As Long, j As Long, n As Long[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Dim bDone As Boolean[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]For[/COLOR] [COLOR=#011993]Each[/COLOR] v [COLOR=#011993]In[/COLOR] vStrings[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        n = n + 1[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Next[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]ReDim[/COLOR] vSorted(1 [COLOR=#011993]To[/COLOR] n)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]ReDim[/COLOR] pos(1 [COLOR=#011993]To[/COLOR] n)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]For[/COLOR] [COLOR=#011993]Each[/COLOR] v [COLOR=#011993]In[/COLOR] vStrings[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        i = i + 1[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        vSorted(i) = v[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Next[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]For[/COLOR] j = 2 [COLOR=#011993]To[/COLOR] n[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        bDone = [COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        [COLOR=#011993]For[/COLOR] i = 2 [COLOR=#011993]To[/COLOR] n[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]            [COLOR=#011993]If[/COLOR] vSorted(i) = vSorted(i - 1) [COLOR=#011993]And[/COLOR] vSorted(i) <> "" [COLOR=#011993]Then[/COLOR][/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]                [/COLOR]' There is a duplicated non-blank cell in the line, we return a specific searchable value,[/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]                [/COLOR]' hence we leave the function.[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                Alphabetize = "Duplicated Cell"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                [COLOR=#011993]Exit[/COLOR] [COLOR=#011993]Function[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]            [COLOR=#011993]Else[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                [COLOR=#011993]If[/COLOR] vSorted(i) < vSorted(i - 1) [COLOR=#011993]Then[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                    v = vSorted(i - 1)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                    vSorted(i - 1) = vSorted(i)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                    vSorted(i) = v[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                    bDone = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                [COLOR=#011993]End[/COLOR] [COLOR=#011993]If[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]            [COLOR=#011993]End[/COLOR] [COLOR=#011993]If[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        [COLOR=#011993]Next[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        [COLOR=#011993]If[/COLOR] bDone [COLOR=#011993]Then[/COLOR] [COLOR=#011993]Exit[/COLOR] [COLOR=#011993]For[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Next[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]For[/COLOR] i = 1 [COLOR=#011993]To[/COLOR] n[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        [COLOR=#011993]If[/COLOR] vSorted(i) <> "" [COLOR=#011993]Then[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]            [COLOR=#011993]If[/COLOR] i = 1 [COLOR=#011993]Then[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                Alphabetize = separator & vSorted(i)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]            [COLOR=#011993]Else[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]                [COLOR=#011993]If[/COLOR] vSorted(i) <> vSorted(i - 1) [COLOR=#011993]Then[/COLOR] Alphabetize = Alphabetize & separator & vSorted(i)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]            [COLOR=#011993]End[/COLOR] [COLOR=#011993]If[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        [COLOR=#011993]End[/COLOR] [COLOR=#011993]If[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Next[/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' This is to remove the separator at the beginning of the result, if any.[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Alphabetize = Mid$(Alphabetize, 1 + Len(separator))[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]End Function



[/FONT][/COLOR]

Code: 
[COLOR=#008F00][FONT=Menlo]' This is the main Macro to create and populate the "Tri" worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Sub[/COLOR] CreateAndPopulateTri()[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We stop the screen being updated while the macro is running[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Application.ScreenUpdating = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We set the calculation to manual[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Application.Calculation = xlManual[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We need to create a new sheet named 'Tri'[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]Call[/COLOR] CreateTriSheet[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Copy the data from the "Original" worksheet to the "Tri" worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]Call[/COLOR] CopyData[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Split the QR column into individual QR codes[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]Call[/COLOR] SplitQRCodes[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We need the last row from columns A to G to propagate the formula[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Lastrow& = Range("A:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]'Create a new column and fill it in with the Alphabetize() formula[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]Call[/COLOR] CreateSignature(Lastrow)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Create a newcolumn and fill it in withSignature, PlanEx and Maladie and a counter[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]Call[/COLOR] CreateSignaturePlanExMaladie(Lastrow)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Create a newcolumn and fill it in withSignature and Maladie and a counter[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]Call[/COLOR] CreateSignatureMaladie(Lastrow)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Now we can set te calculation back to Automatic[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Application.Calculation = xlAutomatic[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We extract unique records for columns L and N[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]Call[/COLOR] ExtractUniqueRecords[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We add a filter to the entire table[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("A1").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Selection.AutoFilter[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We create a little dashboard[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]Call[/COLOR] CreateDashboard[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We resize the columns for readability[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Columns("A:W").EntireColumn.AutoFit[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("A1").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We restore the screen being updated while the macro is running[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Application.ScreenUpdating = [COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#011993][FONT=Menlo]End[COLOR=#000000] [/COLOR]Sub[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo]' This function deletes the "Tri" worksheet if it exists and creates a new one.[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Function[/COLOR] CreateTriSheet()[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]If[/COLOR] [COLOR=#011993]Not[/COLOR] GetWorksheet("Tri") [COLOR=#011993]Is[/COLOR] [COLOR=#011993]Nothing[/COLOR] [COLOR=#011993]Then[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        Application.DisplayAlerts = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        Worksheets("Tri").Delete[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        Application.DisplayAlerts = [COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[COLOR=#011993][FONT=Menlo][COLOR=#000000]    [/COLOR]End[COLOR=#000000] [/COLOR]If[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Sheets("Original").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]Set[/COLOR] ws = Sheets.Add(After:=ActiveSheet)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    ws.Name = "Tri"[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#011993][FONT=Menlo]End[COLOR=#000000] [/COLOR]Function[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo]' This function copies the data from the "Original" worksheet to the "Tri" worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Function[/COLOR] CopyData()[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]    Sheets("Original").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Columns("A:D").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Selection.Copy[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Sheets("Tri").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    ActiveSheet.Paste[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#011993][FONT=Menlo]End[COLOR=#000000] [/COLOR]Function[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo]' This function splits the QR column into individual QR codes[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Function[/COLOR] SplitQRCodes()[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' First we create 6 new columns[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Sheets("Tri").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("B:G").EntireColumn.Insert[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Now we can split the column A into 7 new columns, using 5 characters at a time[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Columns("A:A").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        FieldInfo:=Array(Array(0, 2), Array(5, 2), Array(10, 2), Array(15, 2), Array(20, 2), _[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        Array(25, 2), Array(30, 2)), TrailingMinusNumbers:=[COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We set up the headers to something meaningfull[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("A1").Value = "QR1"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("A1").AutoFill Destination:=Range("A1:G1"), Type:=xlFillDefault[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We set the header row to bold[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Rows(1).Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Selection.Font.Bold = [COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#011993][FONT=Menlo]End[COLOR=#000000] [/COLOR]Function[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo]' This function creates a new column and populate it with the Alphabetize() formula[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Function[/COLOR] CreateSignature(Lastrow [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR])[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We first create a new column H[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("H:H").EntireColumn.Insert[/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We need to set the format to "General", otherwise the formula is not parsed[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("H:H").EntireColumn.NumberFormat = "General"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We set the header for the new column[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("H1").Value = "Signature"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Now we add the formula for each cell in column H[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("H2:H2").Formula = "=Alphabetize((A2,B2,C2,D2,E2,F2,G2), """")"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("H2").AutoFill Destination:=Range("H2:H" & Lastrow)[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#011993][FONT=Menlo]End[COLOR=#000000] [/COLOR]Function[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo]' This function creates a new column and populate it with the Signature, PlanEx and Maladie concatenation, and then a counter column[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Function[/COLOR] CreateSignaturePlanExMaladie(Lastrow [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR])[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We need to set the format to "General", otherwise the formula is not parsed[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("L:L").EntireColumn.NumberFormat = "General"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We set the header for the new column[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("L1").Value = "Signature + PlanEx + Maladie"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Now we add the formula for each cell in column L[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("L2:L2").Formula = "=H2 & ""_"" & K2 & ""_"" & I2"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("L2").AutoFill Destination:=Range("L2:L" & Lastrow)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Now we add a counter column[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We need to set the format to "General", otherwise the formula is not parsed[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("M:M").EntireColumn.NumberFormat = "General"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We set the header for the new column[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("M1").Value = "Compteur"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Now we add the formula for each cell in column M[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("M2:M2").Formula = "=COUNTIF(L:L, L2)"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("M2").AutoFill Destination:=Range("M2:M" & Lastrow)[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#011993][FONT=Menlo]End[COLOR=#000000] [/COLOR]Function[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo]' This function creates a new column and populate it with the Signature and Maladie concatenation, and then a counter column[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Function[/COLOR] CreateSignatureMaladie(Lastrow [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR])[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We need to set the format to "General", otherwise the formula is not parsed[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("N:N").EntireColumn.NumberFormat = "General"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We set the header for the new column[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("N1").Value = "Signature + Maladie"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Now we add the formula for each cell in column L[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("N2:N2").Formula = "=H2 & ""_"" & I2"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("N2").AutoFill Destination:=Range("N2:N" & Lastrow)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Now we add a counter column[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We need to set the format to "General", otherwise the formula is not parsed[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("O:O").EntireColumn.NumberFormat = "General"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We set the header for the new column[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("O1").Value = "Compteur"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Now we add the formula for each cell in column M[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("O2:O2").Formula = "=COUNTIF(N:N, N2)"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("O2").AutoFill Destination:=Range("O2:O" & Lastrow)[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#011993][FONT=Menlo]End[COLOR=#000000] [/COLOR]Function[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo]' This function creates a custom filter to extract unique records from columns L and N and put them in columns V and W respectively[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Function[/COLOR] ExtractUniqueRecords()[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]    Columns("L:L").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("V1"), Unique:=[COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Columns("N:N").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("W1"), Unique:=[COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' We need to adjust the columns titles[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("V1").Value = "Signature + PlanEx + Maladie Uniques"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("W1").Value = "Signature + Maladie Uniques"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#011993][FONT=Menlo]End[COLOR=#000000] [/COLOR]Function[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo]' This function creates a little dashboard with important numbers[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Function[/COLOR] CreateDashboard()[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Titles[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("R6").Value = "Total Signatures:"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("R7").Value = "% Sign. + PlanEx + Maladie Dupliquées:"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("R8").Value = "% Sign. + Maladie Dupliquées:"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("R6:R8").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Selection.Font.Bold = [COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' Formulas[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("S6").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    ActiveCell.Formula = "=COUNTA(H:H) - 1"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("S7").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    ActiveCell.Formula = "=(S6 - COUNTA(V:V) - 1) / S6"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("S8").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    ActiveCell.Formula = "=(S6 - COUNTA(W:W) - 1) / S6"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("S6").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Selection.NumberFormat = "#,##0"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("S7:S8").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Selection.NumberFormat = "0.00%"[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [/FONT][/COLOR]
[COLOR=#008F00][FONT=Menlo][COLOR=#000000]    [/COLOR]' This is just bordering and coloring[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Range("Q5:T9").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Selection.Borders(xlDiagonalDown).LineStyle = xlNone[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Selection.Borders(xlDiagonalUp).LineStyle = xlNone[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]With[/COLOR] Selection.Borders(xlEdgeLeft)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .LineStyle = xlContinuous[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .ColorIndex = 0[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .TintAndShade = 0[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .Weight = xlMedium[/FONT][/COLOR]
[COLOR=#011993][FONT=Menlo][COLOR=#000000]    [/COLOR]End[COLOR=#000000] [/COLOR]With[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]With[/COLOR] Selection.Borders(xlEdgeTop)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .LineStyle = xlContinuous[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .ColorIndex = 0[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .TintAndShade = 0[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .Weight = xlMedium[/FONT][/COLOR]
[COLOR=#011993][FONT=Menlo][COLOR=#000000]    [/COLOR]End[COLOR=#000000] [/COLOR]With[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]With[/COLOR] Selection.Borders(xlEdgeBottom)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .LineStyle = xlContinuous[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .ColorIndex = 0[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .TintAndShade = 0[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .Weight = xlMedium[/FONT][/COLOR]
[COLOR=#011993][FONT=Menlo][COLOR=#000000]    [/COLOR]End[COLOR=#000000] [/COLOR]With[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]With[/COLOR] Selection.Borders(xlEdgeRight)[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .LineStyle = xlContinuous[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .ColorIndex = 0[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .TintAndShade = 0[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .Weight = xlMedium[/FONT][/COLOR]
[COLOR=#011993][FONT=Menlo][COLOR=#000000]    [/COLOR]End[COLOR=#000000] [/COLOR]With[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Selection.Borders(xlInsideVertical).LineStyle = xlNone[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]    [COLOR=#011993]With[/COLOR] Selection.Interior[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .Pattern = xlSolid[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .PatternColorIndex = xlAutomatic[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .ThemeColor = xlThemeColorAccent5[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .TintAndShade = 0.599993896298105[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]        .PatternTintAndShade = 0[/FONT][/COLOR]
[COLOR=#011993][FONT=Menlo][COLOR=#000000]    [/COLOR]End[COLOR=#000000] [/COLOR]With[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#011993][FONT=Menlo]End[COLOR=#000000] [/COLOR]Function[/FONT][/COLOR]

Everything is weel commented. Hope it also helps someone.

Thanks Mike
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,215,219
Messages
6,123,678
Members
449,116
Latest member
HypnoFant

Share this page

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
Back
Top