Highlight Duplicated lines with multiple conditions

[PierremontQuaker03]

Hi,
I am completely new to this forum and to VBA.
I am wanting to create a macro for something I am currently doing manually each month - I want a macro to identify duplicated lines as an example on the attached file. There are certain conditions it must meet for it to be a duplicate which is why a Macro would be better.
Looking at the attached, which is a small quantity of the data I look at on a monthly basis, I want the macro to do the following:

• Check the period – must be in the same period (column B)
• Check the description (J)
• Check the company (Column K)
• Check the absolute amount (Column M)

If there are duplicated lines from all of the above columns I want the duplicated rows from A to AC to be highlighted in grey and the word “Contra” to be entered in Column C.

Is this possible at the click of a button?

Can anybody help?

 

[Marc L]

Hi,​

​

according to this forum rules, edit your thread title in order to use relevant words within as it may help for future searches​

(VBA : we are in a VBA forum so useless || Contra ?‼) and give you more chance to receive some help …​

​

It seems you can reach what you are expecting for without any code just using Excel Basics :​

an easy formula via conditional formatting but to be sure, after editing your thread title,​

according to your initial attachment, join a workbook for the expected result …​

​

 

[PierremontQuaker03]

Thanks, I have edited the title

 

[Nebu]

Hi:

The following Macro

Sub blah()

Dim xlSort As XlSortOrder

i& = Me.Cells(Rows.Count, "A").End(xlUp).Row
With Sheet1
  .Range("B2:AC" & i).Sort Key1:=.Range("B2"), _
   Order1:=xlAscending, Key2:=.Range("J2"), Order2:=xlAscending, Key3:=.Range("K2"), _
   Order3:=xlAscending
   .Range("B2:AC" & i).Sort Key1:=.Range("M2"), Order1:=xlAscending
End With
   
    Dim dic As Object
    Dim v As Variant
    Dim Rng As Range
    Dim j&
    Dim sKey$
   
    Set Rng = Me.Range("B1:M" & i)
    v = Rng
   
    Set dic = CreateObject("Scripting.Dictionary")
   
   For j = 2 To UBound(v, 1)
        sKey = v(j, 1) & "|" & v(j, 9) & "|" & v(j, 10) & "|" & v(j, 12)
            If dic.Exists(sKey) Then
                dic(sKey) = dic(sKey) + 1
            Else
                dic.Add Key:=sKey, Item:=1
            End If
    Next j

    For j = 2 To UBound(v, 1)
        sKey = v(j, 1) & "|" & v(j, 9) & "|" & v(j, 10) & "|" & v(j, 12)
        Me.Range("AD" & j) = dic(sKey)
    Next j
Sheet1.Range("$A$1:$AD$" & i).AutoFilter Field:=30, Criteria1:=">1"

Dim WorkRng As Range
Dim shadeIt As Boolean
shadeIt = True
Set WorkRng = Me.Range("A2:AC" & i)
For Each Rng In WorkRng.Rows

    If Not Rng.EntireRow.Hidden Then
        Rng.Interior.ColorIndex = _
        IIf(shadeIt, 15, xlNone)
        shadeIt = Not (shadeIt)
        If shadeIt = False Then Rng.Columns(3) = "Contra"
    End If
Next
Me.ShowAllData
Me.Range("AD2:AD" & i).ClearContents

End Sub

Click on the Run Button in column AE , after replacing with new data.

Thanks

 

[PierremontQuaker03]

Hi:

The following Macro

Sub blah()

Dim xlSort As XlSortOrder

i& = Me.Cells(Rows.Count, "A").End(xlUp).Row
With Sheet1
  .Range("B2:AC" & i).Sort Key1:=.Range("B2"), _
   Order1:=xlAscending, Key2:=.Range("J2"), Order2:=xlAscending, Key3:=.Range("K2"), _
   Order3:=xlAscending
   .Range("B2:AC" & i).Sort Key1:=.Range("M2"), Order1:=xlAscending
End With
  
    Dim dic As Object
    Dim v As Variant
    Dim Rng As Range
    Dim j&
    Dim sKey$
  
    Set Rng = Me.Range("B1:M" & i)
    v = Rng
  
    Set dic = CreateObject("Scripting.Dictionary")
  
   For j = 2 To UBound(v, 1)
        sKey = v(j, 1) & "|" & v(j, 9) & "|" & v(j, 10) & "|" & v(j, 12)
            If dic.Exists(sKey) Then
                dic(sKey) = dic(sKey) + 1
            Else
                dic.Add Key:=sKey, Item:=1
            End If
    Next j

    For j = 2 To UBound(v, 1)
        sKey = v(j, 1) & "|" & v(j, 9) & "|" & v(j, 10) & "|" & v(j, 12)
        Me.Range("AD" & j) = dic(sKey)
    Next j
Sheet1.Range("$A$1:$AD$" & i).AutoFilter Field:=30, Criteria1:=">1"

Dim WorkRng As Range
Dim shadeIt As Boolean
shadeIt = True
Set WorkRng = Me.Range("A2:AC" & i)
For Each Rng In WorkRng.Rows

    If Not Rng.EntireRow.Hidden Then
        Rng.Interior.ColorIndex = _
        IIf(shadeIt, 15, xlNone)
        shadeIt = Not (shadeIt)
        If shadeIt = False Then Rng.Columns(3) = "Contra"
    End If
Next
Me.ShowAllData
Me.Range("AD2:AD" & i).ClearContents

End Sub

Click on the Run Button in column AE , after replacing with new data.

Thanks

First of all - thank you so much this is fantastic - and will save me a lot of time.
Can I make a couple of adjustments now that I have seen the results.
Firstly, can I add in another check criteria - that is column X - the nominal code.
Secondly, looking at the first contra in row 4 as an example- I want both the duplicate rows (rows 4 and row 5) highlighted in grey with the word contra - because I run a pivot from this and I filter out the contra lines.
Finally, can you add in another tab for a button to run the macro?
Thanks again for your help - your support is much appreciated.
Kind Regards

 

[Nebu]

Hi:

Have modified the code.

Thanks

 

[PierremontQuaker03]

Hi:

Have modified the code.

Thanks

Thanks Nebu - your help is much appreciated again.
Is it possible to highlight both contra lines for each value in grey? That would be very helpful.

Also is it possible to choose a certain month to run the Macro (in the period column (column B)) - once a period it closed off it is finished and I do want it altering any previous month data. Is it possible to put this in the button tab - where it will look up the date.

I am looking forward to learn what you have done here to create this as I start my learning journey - thanks from the UK

 

[Nebu]

Hi:

I have modified the code accordingly.

Thanks

 

[PierremontQuaker03]

Hi:

I have modified the code accordingly.

Thanks

Hi Nebu,
thank you so much. This works great - and will save me a lot of time.
I have tried to copy this to my working file I use however I have realised there are a couple of columns on my working file I missed out which screws up the macro - I am really sorry - can you help again. The range has gone from A:AE now - and I have highlighted the columns in red that we are cross referencing against. I am sure I was close to getting it working but I kept getting mis-match error. I would be so grateful if you could fix again for me and then I will try again to move it to my working file. I feel I am so close and have learned a lot in the last week.
Best Regards

 

[Nebu]

Hi:

Find the attached.

Thanks

 

[PierremontQuaker03]

Hi:

Find the attached.

Thanks

Hi Nebu,
sorry to pester you again, I have tried copying the macro to the master file and I cannot get it to work. Is there an easy way to copy a macro from one file to another, or should I try creating a new master file and use this as the basis of the master file?
Thanks

 

[Nebu]

Hi:
There are two options

- Use the file I uploaded as a template and transfer your data to the file I created
- Copy the macro to the VBA Editor of the sheet where you have your data stored.

It is a simple process if you know the basics of VBA. The error will be happening because the sheet references in my code will be different to sheet you are trying to copy the macro to.

If you are still struggling inbox me your file I will set this up for you, DO NOT UPLOAD YOUR ACTUAL DATA HERE, its a public forum where anyone can access it.

Thanks

 

[PierremontQuaker03]

Hi:
There are two options

- Use the file I uploaded as a template and transfer your data to the file I created
- Copy the macro to the VBA Editor of the sheet where you have your data stored.

It is a simple process if you know the basics of VBA. The error will be happening because the sheet references in my code will be different to sheet you are trying to copy the macro to.

If you are still struggling inbox me your file I will set this up for you, DO NOT UPLOAD YOUR ACTUAL DATA HERE, its a public forum where anyone can access it.

Thanks

thank you I will give it a try again