|
|
|
Author |
Message |
jnelligan
|
Posted: Thu Sep 06 19:33:09 PDT 2007 |
Top |
Excel >> Merge Rows of like data
I get an excel sheet from our accounting department that I import into a
database for reporting. The data is straight forward in most cases, but
today I noticed that there are a lot of rows that are duplicated except for
two columns. Is there a macro or a way to run a script that would look at
these rows and compare them and if all the columns in the row match except
for these two, combine the the columns (these are number columns so I would
like to add the numbers) and create a single row? If so this would really
help me get the reports they need. Any help is appreciated. Here is an
example of the rows I would like combined
1-Jul-07 FIRSTENERGY 605894 0 Region 21 Fuel DLGQ 32334 FA_17RFA
602381 MPFIR US MULTIPLE PLANTS FIRSTENERGY 17x17STD ENG 6028 0 ENGSVCS
Engineering Services US US - -
1-Jul-07 FIRSTENERGY 605894 0 Region 21 Fuel DLGQ 32334 FA_17RFA
602381 MPFIR US MULTIPLE PLANTS FIRSTENERGY 17x17STD ENG 0 61.68 ENGSVCS
Engineering Services US US - -
1-Jul-07 FIRSTENERGY 605894 0 Region 21 Fuel DLGQ 32334 FA_17RFA
602381 MPFIR US MULTIPLE PLANTS FIRSTENERGY 17x17STD ENG 0 4210 ENGSVCS
Engineering Services US US - -
This is what I would like to see
1-Jul-07 FIRSTENERGY 605894 0 Region 21 Fuel DLGQ 32334 FA_17RFA
602381 MPFIR US MULTIPLE PLANTS FIRSTENERGY 17x17STD ENG 6028 4271.68
ENGSVCS Engineering Services US US - -
Thanks.
John
Excel128
|
|
|
|
|
Ken
|
Posted: Thu Sep 06 19:33:09 PDT 2007 |
Top |
Excel >> Merge Rows of like data
> I get an excel sheet from our accounting department that I import into a
> database for reporting. The data is straight forward in most cases, but
> today I noticed that there are a lot of rows that are duplicated except for
> two columns. Is there a macro or a way to run a script that would look at
> these rows and compare them and if all the columns in the row match except
> for these two, combine the the columns (these are number columns so I would
> like to add the numbers) and create a single row? If so this would really
> help me get the reports they need. Any help is appreciated. Here is an
> example of the rows I would like combined
>
> 1-Jul-07 FIRSTENERGY 605894 0 Region 21 Fuel DLGQ 32334 FA_17RFA
> 602381 MPFIR US MULTIPLE PLANTS FIRSTENERGY 17x17STD ENG 6028 0 ENGSVCS
> Engineering Services US US - -
> 1-Jul-07 FIRSTENERGY 605894 0 Region 21 Fuel DLGQ 32334 FA_17RFA
> 602381 MPFIR US MULTIPLE PLANTS FIRSTENERGY 17x17STD ENG 0 61.68 ENGSVCS
> Engineering Services US US - -
> 1-Jul-07 FIRSTENERGY 605894 0 Region 21 Fuel DLGQ 32334 FA_17RFA
> 602381 MPFIR US MULTIPLE PLANTS FIRSTENERGY 17x17STD ENG 0 4210 ENGSVCS
> Engineering Services US US - -
>
> This is what I would like to see
>
> 1-Jul-07 FIRSTENERGY 605894 0 Region 21 Fuel DLGQ 32334 FA_17RFA
> 602381 MPFIR US MULTIPLE PLANTS FIRSTENERGY 17x17STD ENG 6028 4271.68
> ENGSVCS Engineering Services US US - -
>
> Thanks.
>
> John
Hi John,
Try this out on a copy of your worksheet...
Option Explicit
Option Base 1
Public Sub MergeRows()
Dim TallyHeadings As Range
Set TallyHeadings = Application.InputBox( _
prompt:= _
"Select the Headings of the Columns with Values to be Added.", _
Title:= _
"Columns to be Added for Duplicate Rows", _
Default:= _
Selection.Address, _
Type:= _
8)
Dim lnHeadingDepth As Long
lnHeadingDepth = TallyHeadings.Rows.Count
Dim lnHeadingTopRow As Long
lnHeadingTopRow = TallyHeadings.Cells(1).Row
Dim TallyColumns() As Long
Dim TallyHeadingCell As Range
Dim lnTallyCol As Long
Dim T As Long
For Each TallyHeadingCell In TallyHeadings.Rows(1).Cells
lnTallyCol = lnTallyCol + 1
ReDim Preserve TallyColumns(lnTallyCol)
TallyColumns(lnTallyCol) = _
TallyHeadings.Cells(lnTallyCol).Column
Next
Dim lnLastCol As Long
Dim lnLastRow As Long
Dim I As Long, J As Long
lnLastCol = Cells(1, Columns.Count).End(xlToLeft).Column
lnLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For I = lnHeadingDepth + lnHeadingTopRow To lnLastRow
For J = lnLastRow To I + 1 Step -1
If Not RowsAreNotDuplicates( _
TopRange:=Union(Range(Cells(I, 1), _
Cells(I, TallyColumns(1) - 1)), _
Cells(J, TallyColumns(2) + 1)), _
BottomRange:=Union(Range(Cells(J, 1), _
Cells(J, TallyColumns(1) - 1)), _
Cells(J, TallyColumns(2) + 1))) Then
For T = 1 To UBound(TallyColumns)
Cells(I, TallyColumns(T)) = Cells(I, TallyColumns(T)) + _
Cells(J, TallyColumns(T))
Next T
Cells(J, 1).EntireRow.Delete
lnLastRow = lnLastRow - 1
End If
Next J
Next I
End Sub
Public Function RowsAreNotDuplicates(TopRange As Range, _
BottomRange As Range) As Boolean
Dim Cell1 As Range, Cell2 As Range
Dim K As Long, M As Long
For Each Cell1 In TopRange
K = K + 1
For Each Cell2 In BottomRange
M = M + 1
If K = M Then
If Cell1 <> Cell2 Then
RowsAreNotDuplicates = True: Exit For
End If
End If
Next Cell2
M = 0
If RowsAreNotDuplicates Then Exit For
Next Cell1
End Function
I couldn't clearly determine the columns with the numbers to be added
so when the code is run an inputbox pops up asking the user to select
the cells containing the headings of the columns with the values that
you want added for duplicate rows.
The code assumes that these columns are contiguous.
Ken Johnson
|
|
|
|
|
|
|