How To Write A Macro To Compare Active Row With Specific Columns In Above Row

[XL&ME]

Good Morning,

My very limited experience with creating macros has all been with the macro recorder. Can someone please show me how to create a workbook macro to do the following?

Take the first worksheet after Start worksheet and go to row 4 and compare columns B,D,E,I,J,K,L, and M to the row immediately above. If the row immediately above is the same in all of these columns, then delete the current row and go to the next row and repeat until the end of the data. Then go to the next worksheet and repeat until you come to the Stop worksheet.

Note: Column D (M/P) is sorted Z to A and column E (Owner) is sorted A to Z. Then repeat this process

In the attached worksheet I have a before and after macro worksheets. These are prior to the start worksheet to just show a before and after example.

Thanks in advance for any assistance you can give me on this.

[Paul_Hossler]

Try something like this

I deleted any blank leading rows and columns, and froze the panes to keep row 1 at the top

I used the Excel DeleteDuplicates (2007+ I think) so I do't think the sort order matters

Play with it and let me know if it works for you

Option Explicit
Sub test()
    Dim iSheetIndex As Long
        
       
    'turn off updates for speed (really should save the status)
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    
    For iSheetIndex = Worksheets("Start").Index To Worksheets("Stop").Index
        With Worksheets(iSheetIndex)
            
            'skip empty sheets just in case
            If .UsedRange.Cells.Count = 1 Then GoTo NextSheet
            
            'remove empty leading columns and rows
            Do While Application.WorksheetFunction.CountA(.Rows(1)) = 0
                .Rows(1).Delete
            Loop
            Do While Application.WorksheetFunction.CountA(.Columns(1)) = 0
                .Columns(1).Delete
            Loop
            
            'delete dup data
            .Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=Array(2, 4, 8, 9, 10, 11, 12, 13), Header:=xlYes
                
            'select the sheet so we can freeze panes
            .Select
            .Cells(2, 1).Select
            ActiveWindow.FreezePanes = True
        End With
NextSheet:
    Next iSheetIndex
    'turn on again to be neat
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With

End Sub

Depending on what you want to with Start and Stop, you might need to do

For iSheetIndex = Worksheets("Start").Index +1 To Worksheets("Stop").Index -1

[XL&ME]

Paul,

Thank you very much for your code. Apparently I am doing something wrong because the code is not running for me.

I took my sample workbook and copied the data from before macro sheet to county 1. Then deleted the before and after macro sheet. Next I posted your code in a wookbook module and tried F5 and Alt F5. The code does not appear to run.

Attached is the revised workbook with the code. Can you tell me what I am doing wrong? Many thanks for your help.

[XL&ME]

Sorry I posted the wrong file in message #3. Is there any way to have that file deleted?

Here is the correct file. Sorry for the confusion

[Paul_Hossler]

Let me see

Your "After Macros" has several county's but "Before Macro" has only County 1, which seems strange since it's not clear where they came from

I just ran the built in Remove Dups on Before and it went from 43 rows to 36 -- attached.

Are the remaining lines what you're looking for?



Note - I think the WS named Ckeaned should be Cleaned, and three sheets have County<space>number, but County4 doesn't have the space

[Paul_Hossler]

Next I posted your code in a workbook module and tried F5 and Alt F5. The code does not appear to run.

Put it in a standard module

I copied your Before and added 2 copies to County 1 to make sure there were dups.

I copied County 1 to 2, 3 and 4

Can you run the macro in the attached workbook?

[XL&ME]

Paul,

When I go to the Developer tab, visual basic and click in the module 1 and click run or try F5 it does seem to run for me. Can you tell me what I am doing wrong?

[Paul_Hossler]

Do you get a prompt to enable macros?

On Developer tab, in [Macro Security] select Disable all macros with notification

I added a command button on [Start] and 2 msgboxs to the macro to at least show that you're in the macro

Option Explicit
Sub test()
    Dim iSheetIndex As Long
     
     
    If MsgBox("Remove dups?", vbYesNo + vbQuestion, "Demo") = vbNo Then Exit Sub
     
    'turn off updates for speed (really should save the status)
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
     
     
    For iSheetIndex = Worksheets("Start").Index To Worksheets("Stop").Index
        With Worksheets(iSheetIndex)
             
             'skip empty sheets just in case
            If .UsedRange.Cells.Count = 1 Then GoTo NextSheet
             
             'remove empty leading columns and rows
            Do While Application.WorksheetFunction.CountA(.Rows(1)) = 0
                .Rows(1).Delete
            Loop
            Do While Application.WorksheetFunction.CountA(.Columns(1)) = 0
                .Columns(1).Delete
            Loop
             
             'delete dup data
            .Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=Array(2, 4, 8, 9, 10, 11, 12, 13), Header:=xlYes
             
             'select the sheet so we can freeze panes
            .Select
            .Cells(2, 1).Select
            ActiveWindow.FreezePanes = True
        End With
NextSheet:
    Next iSheetIndex
     'turn on again to be neat
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
     
    Call MsgBox("All done!!!", vbInformation + vbOKOnly, "Demo")
     
End Sub

[XL&ME]

Paul,

I took my previous before macro file and highlighted all of the entries that should be deleted and then copied that data over to county 1, county 2, county 3, and county 4. The rows to be deleted have to match the above row in columns, D, E,I,J,K,L, and M. In my original post I included column B which was an error. Hope this helps explain what I am trying to do.

[Paul_Hossler]

Row 7, Col E is Owner 75, one above is Owner 56. I assume that you want to keep row 7, since it's not the same as the one above???

Row 20, Col I is Lender11, others are Lender12. I assume that you want to keep row 20, since it's not the same as the one above???

[XL&ME]

Paul,

The two red highlighted items in column N should be deleted based on the conditions I had stated. I messed up when generating the test data. I had meant to make the owner the same as the above item for the first red item and the lender the same as the one above in the second red item. I did the highlighting based on quickly looking down the list and I made the mistake. Thanks for continuing to try and solve my problem,

[Paul_Hossler]

Assuming the two lines above stay, the macro in the attached XLSM deletes the yellow lines based on the Excel [Remove Duplicates] function checking columns 4, 5,9, 10, 11, 12, and 13

Option Explicit
Sub test()
    Dim iSheetIndex As Long
     
     
    If MsgBox("Remove dups?", vbYesNo + vbQuestion, "Demo") = vbNo Then Exit Sub
     
    'turn off updates for speed (really should save the status)
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
     
     
    For iSheetIndex = Worksheets("Start").Index To Worksheets("Stop").Index
        With Worksheets(iSheetIndex)
             
             'skip empty sheets just in case
            If .UsedRange.Cells.Count = 1 Then GoTo NextSheet
             
             'remove empty leading columns and rows
            Do While Application.WorksheetFunction.CountA(.Rows(1)) = 0
                .Rows(1).Delete
            Loop
            Do While Application.WorksheetFunction.CountA(.Columns(1)) = 0
                .Columns(1).Delete
            Loop
             
             'delete dup data
            .Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=Array(4, 5, 9, 10, 11, 12, 13), Header:=xlYes
             
             'select the sheet so we can freeze panes
            .Select
            .Cells(2, 1).Select
            ActiveWindow.FreezePanes = True
        End With
NextSheet:
    Next iSheetIndex
     'turn on again to be neat
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
     
    Call MsgBox("All done!!!", vbInformation + vbOKOnly, "Demo")
     
End Sub

I still can't see where the "After Macro" sheet data comes from since it has lines that were not in the 'Before Macro" sheet.

I just went with your 4 County sheets and the data there

[Paul_Hossler]

The two red highlighted items in column N should be deleted based on the conditions I had stated. I messed up when generating the test data. I had meant to make the owner the same as the above item for the first red item and the lender the same as the one above in the second red item. I did the highlighting based on quickly looking down the list and I made the mistake. Thanks for continuing to try and solve my problem,

Try this one then with the test data revised

Did you get macros to run?

[XL&ME]

Paul,

I think you nailed it this time. Give me a little bit of time and I will try it on several files of actual data. Thanks again!!!

[XL&ME]

Paul,

The latest macro does seem to have done the job on two different test. Since both test involves a lot of data, I am going to wait until tomorrow to check each line of data. My old eyes are just too tired tonight, so I am going to do it tomorrow. Will definitely let you know the results when I finish the checking. Many many thanks for your help.

[Paul_Hossler]

Ok

I don't really like hard-coding the column numbers in like that

If there's a chance the columns could change or the "County x" sheets are formatted in different orders, I can make it more general purpose if needed

[XL&ME]

Good Afternoon Paul,

Your last macro worked like fantastically well. I ran the macro on two county sheets, one with 11,312 rows and one with 15,321.

I understand what you are saying about hard coding the column numbers. If I would later have to add, delete, or rearrange the columns, could I just readjust the column numbers in the array?

If you could, would you go ahead and make the sheet names more general. Each sheet tab will be the name of that county.

Thanks again for your great help!!!

[Paul_Hossler]

1. Adjust column numbers in the RemoveDups if things change

Columns:=Array(4, 5, 9, 10, 11, 12, 13),


2. The macro runs on what ever worksheets are between the sheet named "Start" and the sheet named "Stop", no assumptions as to name

For iSheetIndex = Worksheets("Start").Index To Worksheets("Stop").Index


3. It's easy enough to go through all worksheets, and

if the word "County" in A1 do that sheet, or

only do sheet names that start with "County", like "County-Chester" or "County Lancaster", or

Only run the macro on the active sheet

[XL&ME]

Paul,

If it would not be too much trouble, could you change the macro to do all sheets with the word "County" in A1. Then that way I eliminate the start and stop sheets. Thanks!

Jim

[Paul_Hossler]

No trouble at all

Option Explicit

Sub test()
    Dim ws As Worksheet
     
     
    If MsgBox("Remove dups?", vbYesNo + vbQuestion, "Demo") = vbNo Then Exit Sub
     
     'turn off updates for speed (really should save the status)
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
     
     
    For Each ws In ActiveWorkbook.Worksheets
       With ws
             
             'skip empty sheets just in case
            If .UsedRange.Cells.Count = 1 Then GoTo NextSheet
             
             'remove empty leading columns and rows
            Do While Application.WorksheetFunction.CountA(.Rows(1)) = 0
                .Rows(1).Delete
            Loop
            Do While Application.WorksheetFunction.CountA(.Columns(1)) = 0
                .Columns(1).Delete
            Loop
             
             If .Range("A1").Value = "County" Then
                 'delete dup data
                .Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=Array(4, 5, 9, 10, 11, 12, 13), Header:=xlYes
             
                 'select the sheet so we can freeze panes
                .Select
                .Cells(2, 1).Select
                ActiveWindow.FreezePanes = True
           End If
        End With
NextSheet:
    Next
     'turn on again to be neat
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
     
    Call MsgBox("All done!!!", vbInformation + vbOKOnly, "Demo")
     
End Sub