Results 1 to 10 of 10

Thread: Code To Remove Only 2 Rows
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular Dazzawm's Avatar
    Join Date
    Jan 2011
    Location
    UK
    Posts
    3,375
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    0 Thread(s)

    Default Code To Remove Only 2 Rows

    I have a sheet as below. Whenever there are 2 rows only that match in K then I want them removed to another sheet. This must be when there is one heater blower and one heater in column AF. So in this example below rows 2-4 and 5-7 will remain as there are 3 rows but the rest would be removed to another sheet as there are only 2 rows and there is one description for each.

    Excel 2010#DAE7F5 " />#DAE7F5 ;text-align: center;color: #161120">
    KLMNOPQRSTUVWXYZAAABACADAEAFAGAH
    2M14301280143001Heater Blower
    3M14301280143001Heater
    4M14301280143001Heater
    5M14301280143003Heater Blower
    6M14301280143003Heater
    7M14301280143003Heater
    8M14301280145007Heater Blower
    9M14301280145007Heater
    10M14301280145011Heater Blower
    11M14301280145011Heater
    12M14301280145008Heater Blower
    13M14301280145008Heater
    14M14301280145002Heater Blower
    15M14301280145002Heater
    16M14301280145005Heater Blower
    17M14301280145005Heater

    #DAE7F5 ;color: #161120">Sheet1



    The more I learn the more I realise I knew nothing!

    Thanks For All Your Help

    Home - Windows 10, Excel 2013

    Work - Windows 7, Excel 2010 Home & Business

  2. #2
    Board Regular Dazzawm's Avatar
    Join Date
    Jan 2011
    Location
    UK
    Posts
    3,375
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Code To Remove Only 2 Rows

    I hope I explained this ok, please post should you need clarification.
    The more I learn the more I realise I knew nothing!

    Thanks For All Your Help

    Home - Windows 10, Excel 2013

    Work - Windows 7, Excel 2010 Home & Business

  3. #3
    Board Regular Dazzawm's Avatar
    Join Date
    Jan 2011
    Location
    UK
    Posts
    3,375
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Code To Remove Only 2 Rows

    Can anyone help with this please?
    The more I learn the more I realise I knew nothing!

    Thanks For All Your Help

    Home - Windows 10, Excel 2013

    Work - Windows 7, Excel 2010 Home & Business

  4. #4
    Board Regular Dazzawm's Avatar
    Join Date
    Jan 2011
    Location
    UK
    Posts
    3,375
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Code To Remove Only 2 Rows

    Is this a complicated code I am needing?
    The more I learn the more I realise I knew nothing!

    Thanks For All Your Help

    Home - Windows 10, Excel 2013

    Work - Windows 7, Excel 2010 Home & Business

  5. #5
    MrExcel MVP
    Junior Admin
    Joe4's Avatar
    Join Date
    Aug 2002
    Posts
    50,720
    Post Thanks / Like
    Mentioned
    57 Post(s)
    Tagged
    11 Thread(s)

    Default Re: Code To Remove Only 2 Rows

    Here is one way to do it:

    Enter this formula in cell AI2 and copy down for all rows:
    Code:
    =AND(COUNTIF(K:K,K2)=2,COUNTIFS(K:K,K2,AF:AF,"Heater Blower")=1,COUNTIFS(K:K,K2,AF:AF,"Heater")=1)
    This should identify every row that needs to be moved by returning "TRUE".
    You can then use Advanced Filters to copy them to another sheet, and then delete the TRUE entries from the original sheet.
    TIPS FOR FINDING EXCEL SOLUTIONS
    1. Use the built-in Help that comes with Excel/Access
    2. Use the Search functionality on this board
    3. A lot of VBA code can be acquired by using the Macro Recorder.

    "Give a man a fish, feed him for a day. Teach a man to fish, feed him for life!"

  6. #6
    MrExcel MVP
    Junior Admin
    Joe4's Avatar
    Join Date
    Aug 2002
    Posts
    50,720
    Post Thanks / Like
    Mentioned
    57 Post(s)
    Tagged
    11 Thread(s)

    Default Re: Code To Remove Only 2 Rows

    Here is the VBA code that I came up with to do this:
    Code:
    Sub MyMoveMacro()
    
        Dim lr As Long
        Dim sh1 As Worksheet, sh2 As Worksheet
    
        Application.ScreenUpdating = False
    
    '   Set worksheet data resides on
        Set sh1 = Sheets("Sheet1")
    '   Set worksheet to copy data to
        Set sh2 = Sheets("Sheet2")
    
    '   Find last row with data in column K
        lr = sh1.Cells(Rows.Count, "K").End(xlUp).Row
    
    '   Populate formula in column AI
        sh1.Range("AI1") = "Move"
        sh1.Range("AI2:AI" & lr).FormulaR1C1 = _
            "=AND(COUNTIF(C[-24],RC[-24])=2,COUNTIFS(C[-24],RC[-24],C[-3],""Heater Blower"")=1,COUNTIFS(C[-24],RC[-24],C[-3],""Heater"")=1)"
    
    '   Filter TRUE entries to new sheet
        sh2.Activate
        sh2.Range("AK1") = "Move"
        sh2.Range("AK2") = "TRUE"
        sh1.Range("K1:AI" & lr).AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Range("AK1:AK2"), CopyToRange:=Range("K1"), Unique:=False
        sh2.Columns("AI:AK").ClearContents
        sh2.Cells.EntireColumn.AutoFit
        
    '   Delete TRUE entries from original sheet
        sh1.Activate
        sh1.Range("$K$1:$AI$" & lr).AutoFilter Field:=25, Criteria1:="TRUE"
        Application.DisplayAlerts = False
        ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
        Application.DisplayAlerts = True
        sh1.AutoFilterMode = False
        sh1.Columns("AI:AI").ClearContents
    
        Application.ScreenUpdating = True
    
    End Sub
    Note that you will need to update the value of the "sh1" and "sh2" variables to reflect the names of the sheet that you are working with.
    I am also assuming that your data is in columns K:AH. If we need to extend it out to include other columns, the code may need to be altered.
    TIPS FOR FINDING EXCEL SOLUTIONS
    1. Use the built-in Help that comes with Excel/Access
    2. Use the Search functionality on this board
    3. A lot of VBA code can be acquired by using the Macro Recorder.

    "Give a man a fish, feed him for a day. Teach a man to fish, feed him for life!"

  7. #7
    Board Regular Dazzawm's Avatar
    Join Date
    Jan 2011
    Location
    UK
    Posts
    3,375
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Code To Remove Only 2 Rows

    Sorry the data starts in A to AV. I thought I would just include the important data to make it clearer.
    The more I learn the more I realise I knew nothing!

    Thanks For All Your Help

    Home - Windows 10, Excel 2013

    Work - Windows 7, Excel 2010 Home & Business

  8. #8
    MrExcel MVP
    Junior Admin
    Joe4's Avatar
    Join Date
    Aug 2002
    Posts
    50,720
    Post Thanks / Like
    Mentioned
    57 Post(s)
    Tagged
    11 Thread(s)

    Default Re: Code To Remove Only 2 Rows

    Yes, it is important to mention that, since you want to move those cells too.

    Try this variation:
    Code:
    Sub MyMoveMacro()
    
        Dim lr As Long
        Dim sh1 As Worksheet, sh2 As Worksheet
    
        Application.ScreenUpdating = False
    
    '   Set worksheet data resides on
        Set sh1 = Sheets("Sheet1")
    '   Set worksheet to copy data to
        Set sh2 = Sheets("Sheet2")
    
    '   Find last row with data in column K
        lr = sh1.Cells(Rows.Count, "K").End(xlUp).Row
    
    '   Populate formula in column AW
        sh1.Range("AW1") = "Move"
        sh1.Range("AW2:AW" & lr).FormulaR1C1 = _
            "=AND(COUNTIF(C[-38],RC[-38])=2,COUNTIFS(C[-38],RC[-38],C[-17],""Heater Blower"")=1,COUNTIFS(C[-38],RC[-38],C[-17],""Heater"")=1)"
    
    '   Filter TRUE entries to new sheet
        sh2.Activate
        sh2.Range("AX1") = "Move"
        sh2.Range("AX2") = "TRUE"
        sh1.Range("A1:AW" & lr).AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Range("AX1:AX2"), CopyToRange:=Range("A1"), Unique:=False
        sh2.Columns("AW:AX").ClearContents
        sh2.Cells.EntireColumn.AutoFit
        
    '   Delete TRUE entries from original sheet
        sh1.Activate
        sh1.Range("$A$1:$AW$" & lr).AutoFilter Field:=49, Criteria1:="TRUE"
        Application.DisplayAlerts = False
        ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
        Application.DisplayAlerts = True
        sh1.AutoFilterMode = False
        sh1.Columns("AW:AW").ClearContents
    
        Application.ScreenUpdating = True
    
    End Sub
    TIPS FOR FINDING EXCEL SOLUTIONS
    1. Use the built-in Help that comes with Excel/Access
    2. Use the Search functionality on this board
    3. A lot of VBA code can be acquired by using the Macro Recorder.

    "Give a man a fish, feed him for a day. Teach a man to fish, feed him for life!"

  9. #9
    Board Regular Dazzawm's Avatar
    Join Date
    Jan 2011
    Location
    UK
    Posts
    3,375
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Code To Remove Only 2 Rows

    Thanks Joe I run the code and it completed but nothing moved to sheet 2? It looks like it removed them but didn't paste them onto sheet 2.
    Last edited by Dazzawm; Sep 25th, 2019 at 02:30 AM.
    The more I learn the more I realise I knew nothing!

    Thanks For All Your Help

    Home - Windows 10, Excel 2013

    Work - Windows 7, Excel 2010 Home & Business

  10. #10
    Board Regular Dazzawm's Avatar
    Join Date
    Jan 2011
    Location
    UK
    Posts
    3,375
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Code To Remove Only 2 Rows

    Don't worry I used the formula and that done the job. Thanks.
    The more I learn the more I realise I knew nothing!

    Thanks For All Your Help

    Home - Windows 10, Excel 2013

    Work - Windows 7, Excel 2010 Home & Business

Some videos you may like

User Tag List

Tags for this Thread

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
  •