+ Reply to Thread
Results 1 to 3 of 3

I need a macro to delete rows when cells and adjacent cells equal another pair

  1. #1
    Registered User
    Join Date
    03-31-2017
    Location
    uSa
    MS-Off Ver
    2018
    Posts
    3

    I need a macro to delete rows when cells and adjacent cells equal another pair

    So i have three columns - A will contain repair orders, B will contain amounts, C is irrelevant in this case. Out of around 200 samples, 30-40 rows need to be deleted. They will have the same value in column A. However, column B will have opposite values - they will net $0.00 and i need those lines deleted. But not all matching values in A will have matching values in B. Values in B that dont match must remain on the sheet.

    So, I need to find out how to write a macro to look in column A, find duplicates, then look in column B and find same absolute values (but with different signs) and delete these rows. Column B values must depend on column A because i will have numerous repair orders closing for $5.00 in column B.
    Attached is a sample data. First 6 rows are "in and out" net $0.00. So the macro must identify that and delete rows 1-6. The last two rows are giving me a difference of $1.00-those two rows must stay on the spreadsheet.

    952527 272.20 paid not closed 09.01-09.06
    952541 6.65 paid not closed 09.01-09.06
    952628 5 paid not clsoed 09.01-09.06
    952527 -272.20 closed not paid
    952541 -6.65 closed not paid
    952628 -5.00 closed not paid
    952528 104.00 paid not closed 09.01-09.06
    952528 -105.00 closed not paid

    Thanks.

  2. #2
    Valued Forum Contributor
    Join Date
    11-02-2016
    Location
    NY
    MS-Off Ver
    2010
    Posts
    371

    Re: I need a macro to delete rows when cells and adjacent cells equal another pair

    Add a column for Absolute value of the numbers in Column B (you can then use your newly added column for Absolute values, let's say J, to do 1st sort and then sort on Column B. This should make it easy to see what 'matches' up and can be eliminated. I add another column, lets say K, and for the equal & opposite amounts I put 'Del' in column K. Then, you can filter on just K(all the amounts you are about to delete) to ensure that they add to 0 IN COLUMN B(where they are the original amounts) if the total is 0, filter on COlumn K for 'Del' ~ it's then ok to delete all these net to 0 amounts.

  3. #3
    Registered User
    Join Date
    09-11-2017
    Location
    England
    MS-Off Ver
    2013/2018
    Posts
    3

    Re: I need a macro to delete rows when cells and adjacent cells equal another pair

    Copy and paste this code into a macro file. A bit longwinded but it should work for anything up to 100 rows of data.

    Sub Macro1()
    '
    ' Macro1 Macro
    '

    '
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=IF(SUMIF(C1,RC[-3],C2)=0,1,0)"
    Range("D1").Select
    Selection.AutoFill Destination:=Range("D1:D100")
    Range("D1:D100").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A1:D1").Select
    Range("D1").Activate
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Sheet4").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet4").AutoFilter.Sort.SortFields.Add Key:=Range _
    ("D1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet4").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    ActiveSheet.Range("$A$1:$D$9").AutoFilter Field:=4, Criteria1:="1"
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    ActiveSheet.Range("$A$1:$D$100").AutoFilter Field:=4
    Columns("A:D").Select
    ActiveWorkbook.Worksheets("Sheet4").AutoFilter.Sort.SortFields.Clear
    Range("A2").Select
    ActiveWorkbook.Worksheets("Sheet4").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet4").AutoFilter.Sort.SortFields.Add Key:=Range _
    ("D1:D9"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet4").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    End Sub

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] Find Word And Set Cells To Equal Adjacent Cell Value if Criteria Is Met
    By ScabbyDog in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 02-04-2016, 03:48 AM
  2. [SOLVED] Code needed to delete empty cells + adjacent cells
    By RobinMO01 in forum Excel Programming / VBA / Macros
    Replies: 8
    Last Post: 08-21-2015, 03:52 PM
  3. [SOLVED] SUM cells with equal values in an adjacent column.
    By angelopc in forum Excel Programming / VBA / Macros
    Replies: 12
    Last Post: 12-13-2013, 09:55 AM
  4. Counting adjacent cells(text) to equal one value
    By Calithea in forum Excel Formulas & Functions
    Replies: 5
    Last Post: 12-29-2012, 04:08 AM
  5. ►[SOLVED] by Richard Buttrey - Message Box Error when Adjacent Cells Equal
    By xsoldoutx in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 09-13-2012, 08:07 AM
  6. auto merge adjacent cells into one if cell values are equal
    By egosselin in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 01-04-2012, 12:24 AM
  7. Delete rows based on cells that equal zero
    By jadown in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 01-04-2011, 11:21 AM

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1