PDA

View Full Version : [SOLVED] How To Write A Macro To Compare Active Row With Specific Columns In Above Row



XL&ME
04-12-2015, 06:52 AM
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
04-12-2015, 08:09 AM
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
04-12-2015, 09:02 AM
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
04-12-2015, 09:21 AM
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
04-12-2015, 12:56 PM
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
04-12-2015, 01:39 PM
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
04-12-2015, 02:01 PM
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
04-12-2015, 02:12 PM
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
04-12-2015, 02:30 PM
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
04-12-2015, 04:03 PM
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
04-12-2015, 04:15 PM
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
04-12-2015, 04:19 PM
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
04-12-2015, 04:23 PM
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
04-12-2015, 04:40 PM
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
04-12-2015, 05:11 PM
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
04-12-2015, 05:35 PM
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
04-13-2015, 10:53 AM
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
04-13-2015, 11:32 AM
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
04-13-2015, 11:57 AM
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
04-13-2015, 01:23 PM
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

XL&ME
04-13-2015, 04:20 PM
Paul,

Your latest version of the macro works like a champ. Thank you!!!

Jim