Results 1 to 8 of 8

insert a blank row after each group of duplicate entries

This is a discussion on insert a blank row after each group of duplicate entries within the Excel Questions forums, part of the Question Forums category; Help needed! After sorting my data, column B shows a lot of duplicate entries. I want to write a macro ...

  1. #1
    New Member
    Join Date
    Feb 2005
    Posts
    2

    Default insert a blank row after each group of duplicate entries

    Help needed!
    After sorting my data, column B shows a lot of duplicate entries.

    I want to write a macro that will, insert a blank row after each group of duplicate entries, this will enable me to see them more easily. I want this process to find the last active row in the worksheet then start.

  2. #2
    acw
    acw is offline
    MrExcel MVP
    Join Date
    Feb 2004
    Posts
    4,814

    Default

    Hi

    This should get you started.

    Tony

    Sub aaa()
    Range("b65536").End(xlUp).Select
    While ActiveCell.Row > 2
    While ActiveCell = ActiveCell.Offset(-1, 0)
    ActiveCell.Offset(-1, 0).Select
    Wend
    If ActiveCell.Row > 2 Then
    ActiveCell.EntireRow.Insert
    ActiveCell.Offset(-1, 0).Select
    End If
    Wend
    End Sub

  3. #3
    MrExcel MVP erik.van.geit's Avatar
    Join Date
    Feb 2003
    Location
    Belgium 3272 Testelt
    Posts
    17,767

    Default Re: insert a blank row after each group of duplicate entries

    Hello, Matex,

    WELCOME to the Board!

    Here an alternative. It works with some "formula-tricks" to perform your operation very quickly. If there are a lot of rows, consider this code, else acw's code, which is easier to understand at first sight, will do.

    kind regards,
    Erik

    Code:
    Option Explicit
    
    Sub insert_rows_if2()
    'Erik Van Geit
    'June 15 2004
    Dim rng1 As Range
    Dim rng2 As Range
    Dim LR As Long
    Application.ScreenUpdating = False
    Columns(2).EntireColumn.Insert
    LR = Range("C65536").End(xlUp).Row
    Set rng1 = Range(Cells(2, 2), Cells(LR, 2))
    Set rng2 = Range(Cells(LR + 1, 2), Cells(LR * 2, 2))
    Cells(1, 2) = "header"
    Cells(LR + 1, 2) = "header"
    With rng1
        .FormulaR1C1 = "=IF(RC[1]=R[1]C[1],"""",COUNTIF(R1C1:R[-1]C,"">0"") +1)"
        .Copy
        .PasteSpecial xlPasteValues
        Union(Range("B1"), rng1).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Columns _
        ("A:A"), CopyToRange:=rng2, Unique:=True
    End With
    
    With rng2
        .Find("header", LookIn:=xlValues).Delete
        On Error Resume Next
        .Find("", LookIn:=xlValues).Delete
        On Error GoTo 0
        .EntireColumn.Insert
    End With
    
    LR = Range("C65536").End(xlUp).Row
    With Range(Cells(2, 2), Cells(LR, 2))
        .FormulaR1C1 = "=IF(RC[1]<>"""",RC[1],R[-1]C+0.0000001)"
        .Copy
        .PasteSpecial xlPasteValues
        '.EntireColumn.Delete
        .EntireRow.Sort Key1:=[B1]
    End With
    Columns("B:C").Delete
    Application.ScreenUpdating = True
    End Sub

  4. #4
    MrExcel MVP
    Join Date
    Apr 2002
    Location
    Vancouver BC , Canada
    Posts
    6,259

    Default Re: insert a blank row after each group of duplicate entries

    This sol'n assumes your dupes are in column "A:A" and that they are already sorted

    Sub SpaceAfterDupes()
    With Columns("A:A")
    .Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(1), Replace:=True
    Columns("A:A").SpecialCells(xlCellTypeConstants, 2).EntireRow.ClearContents
    .RemoveSubtotal
    Columns("A:A").Delete
    End With
    End Sub

    <MARQUEE>...........Never be afraid to try something new. Remember, amateurs built the ark, professionals built the Titanic...............The easiest thing to find is fault, don't be easy !.. --Anonymous--...</marquee>

  5. #5
    MrExcel MVP erik.van.geit's Avatar
    Join Date
    Feb 2003
    Location
    Belgium 3272 Testelt
    Posts
    17,767

    Default Re: insert a blank row after each group of duplicate entries

    Nimrod,


    really very fast and ... no workaround
    just using built-in functions

    (I never used subtotals: great feature!)

    kind regards,
    Erik

  6. #6
    MrExcel MVP
    Join Date
    Apr 2002
    Location
    Vancouver BC , Canada
    Posts
    6,259

    Default Re: insert a blank row after each group of duplicate entries

    Hello Erik
    I've enjoyed many of your postings as well ... thanks for the feedback .. cheers ...

    <MARQUEE>...........Never be afraid to try something new. Remember, amateurs built the ark, professionals built the Titanic...............The easiest thing to find is fault, don't be easy !.. --Anonymous--...</marquee>

  7. #7
    New Member
    Join Date
    Feb 2005
    Posts
    2

    Default Re: insert a blank row after each group of duplicate entries

    Many thanks to all, each one worked great

  8. #8
    New Member
    Join Date
    Mar 2013
    Posts
    1

    Default Re: insert a blank row after each group of duplicate entries

    I love this. If I wanted to leave a subtotal SUM in columns J:AX, how would this be modified?

    Quote Originally Posted by Nimrod View Post
    This sol'n assumes your dupes are in column "A:A" and that they are already sorted

    Sub SpaceAfterDupes()
    With Columns("A:A")
    .Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(1), Replace:=True
    Columns("A:A").SpecialCells(xlCellTypeConstants, 2).EntireRow.ClearContents
    .RemoveSubtotal
    Columns("A:A").Delete
    End With
    End Sub

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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


DMCA.com