Add cells if values are the same in multiple columns

[Guest]

Question from a newbie. Ok, this may sound simple but I have no idea what to do. I use this macro below that I got from this site. It searches column "A" for duplicates and adds other specific columns. What I need to find out is how to set it up to test for multiple duplicates (I will have 4 test values) (ie. If Columns A, D, E, F in row one are the same as in row two then add columns G,H,I,J and then delete row two

If anyone needs anymore information I will gladly provide it, as my working knowledge doesn't go much past "record a macro" or copy and paste one that I find here into a workbook. I have no idea if this is even possible, but it would help alot if someone can help me, as the file I need to do this to is about 8,000 rows long and will tak eme forever to do by hand

Sub Main(
Dim rng As Rang
Dim rngFirst As Rang
Dim c As Rang
Dim lRow As Lon
Dim cLastRow As Lon

'hard coded range :-
cLastRow = Cells(Rows.Count, "A").End(xlUp).Ro
Set rng = Range("A2", Range("A" & Rows.Count).End(xlUp)
For lRow = 1 To rng.Rows.Coun
'step thru all cells :-
If Len(rng.Cells(lRow).Text) > 0 The
Set c = rng.Find(What:=rng.Cells(lRow)
If Not c Is Nothing The
Set rngFirst =
D

Set c = rng.FindNext(c
If (Not c Is Nothing) And
(c.Address <> rngFirst.Address) The

'sum data (as if the 6th col. were a qty
rngFirst.Offset(0, 2) =
c.Offset(0, 2) + rngFirst.Offset(0, 2
rngFirst.Offset(0, 3) =
c.Offset(0, 3) + rngFirst.Offset(0, 3
rngFirst.Offset(0, 4) =
c.Offset(0, 4) + rngFirst.Offset(0, 4
rngFirst.Offset(0, 5) =
c.Offset(0, 5) + rngFirst.Offset(0, 5
rngFirst.Offset(0, 6) =
c.Offset(0, 6) + rngFirst.Offset(0, 6)

'or copy data. whatever
'(this copies 3th thru 4th cell to right of c
'to 5th cell to right of rngFirst
'Range(c.Offset(0, 3), c.Offset(0, 4)).Copy
' rngFirst.Offset(0, 5
'remove this instance of the I
c.Clea
Els
Exit D
End I
Loo
End I
End I
Next lRo
'Remove all rows where we clear the I
rng.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delet
End Su

Thank you very much for your time and consideration, as I am los

Erin Myers

 

[Dave Peterson]

I didn't use the code you found. I just looked at columns A, D, E, F to see if
they matched the row above.

If they did, then I added the values and deleted the bottom row.

Since this destoys data, make sure you use a test copy of the worksheet--or
don't save it after you've run it!

Option Explicit
Sub testme02()
'
'If Columns A, D, E, F in row one are the same as in row two
'then add columns G,H,I,J and then delete row two)

Dim wks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim ColsToCheck As Variant
Dim ColsToAdd As Variant
Dim iCtr As Long
Dim diffFound As Boolean
Dim errorsFound As Boolean

ColsToCheck = Array("a", "d", "E", "f")
ColsToAdd = Array("g", "h", "I", "j")

Set wks = ActiveSheet

With wks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
diffFound = False
For iCtr = LBound(ColsToCheck) To UBound(ColsToCheck)
If .Cells(iRow, ColsToCheck(iCtr)).Value _
<> .Cells(iRow - 1, ColsToCheck(iCtr)).Value Then
diffFound = True
Exit For
End If
Next iCtr

If diffFound = False Then
errorsFound = False
For iCtr = LBound(ColsToAdd) To UBound(ColsToAdd)
If IsNumeric(.Cells(iRow, ColsToAdd(iCtr)).Value) _
And IsNumeric(.Cells(iRow - 1, _
ColsToAdd(iCtr)).Value) Then
.Cells(iRow - 1, ColsToAdd(iCtr)).Value _
= .Cells(iRow - 1, ColsToAdd(iCtr)).Value _
+ .Cells(iRow, ColsToAdd(iCtr)).Value
Else
MsgBox "Error on rows: " & iRow _
& vbLf & "columns: " & ColsToAdd(iCtr)
errorsFound = True
End If
Next iCtr
If errorsFound = False Then
.Rows(iRow).EntireRow.Delete
End If
End If
Next iRow
End With

End Sub

 

[Dave Peterson]

You could turn calculation to manual, run the macro and put it back to what it
was.

And since it's deleting a bunch of lines, make sure
tools|Options|view tab|page breaks is unchecked.

An alternative.

add headers to each column
select your range
data|pivottable
follow the wizard until you get to the step with a layout button on it.
Hit that layout button.

drag the button for A, D, E, F to the row range
drag the button for G, H, I, J to the data range

finish up the wizard

Drag the "data" button to the cell directly to its right.

Double click on each of the A, D, E, F headers and turn off the subtotals.

If you like it and need the data as data (not as a pivot table), you can
copy|paste special values and then use some of the techniques at Debra
Dalgleish's site to fill the empty cells with the one above it:

http://www.contextures.com/xlDataEntry02.html


When I have to do this, sometimes I'll create a helper column and concatenate my
columns (but separate by a unique character):

=a2&"."&d2&"."&e2&"."&f2
then drag down.

then use a pivot table to summarize by that column

Convert to values and then do Data|text to columns to separate them again.