Hello Experts,
I had to repost this question as my original Sept 24th's posting crashed
along with everyone else's postings.

How do you, in code, group according to similar names, then consolidate
all of the row's "X"'s into a single line? Such as;
1) Group each similar name within Column A;
2) Start with the last line within that group;
3) Copy and Paste Special, Skip Blanks, onto the next row up
4) Then, go back down to the last row within the group;
5) Delete last row within the group
6) Loop; until all multiple names become just one row per name.

To Illustrate:
[Column]
A B C D E
Bill X X
Bill X X X
Bill X X
Sue X
Sue X
Bob X X
Bob X X

Should become:
A B C D E
Bill X X X X X
Sue X X
Bob X X X X


Thanks in advance,
Ricky

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Are these really X's?

If yes, then this might work ok:

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long

Dim FirstCol As Long
Dim iCol As Long

Set wks = Worksheets("sheet1")

With wks
FirstRow = 2 'header row?
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 2 'names in column A

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
For iCol = FirstCol To _
.Cells(iRow, .Columns.Count).End(xlToLeft).Column
If IsEmpty(.Cells(iRow, iCol)) Then
'do nothing
Else
'just move it up and overwrite anything there?
.Cells(iRow - 1, iCol).Value = .Cells(iRow, iCol).Value
End If
Next iCol
'delete this row with the same name
.Rows(iRow).Delete
End If
Next iRow
End With

End Sub

It keeps the value in the bottom row during the comparison.

Ricky Pang wrote:

Hello Experts,
I had to repost this question as my original Sept 24th's posting crashed
along with everyone else's postings.

How do you, in code, group according to similar names, then consolidate
all of the row's "X"'s into a single line? Such as;
1) Group each similar name within Column A;
2) Start with the last line within that group;
3) Copy and Paste Special, Skip Blanks, onto the next row up
4) Then, go back down to the last row within the group;
5) Delete last row within the group
6) Loop; until all multiple names become just one row per name.

To Illustrate:
[Column]
A B C D E
Bill X X
Bill X X X
Bill X X
Sue X
Sue X
Bob X X
Bob X X

Should become:
A B C D E
Bill X X X X X
Sue X X
Bob X X X X

Thanks in advance,
Ricky

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

--

Dave Peterson

Hi Dave,
I appreciate your response. The data in the cells would be either "X"s
or "1"s. After running your macro, I've elected to go with the "1"s
instead.

On your post:
With wks
FirstRow = 2 'header row? [Yes]
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 2 'names in column A
Question:
As the search criteria is based on Column A's names, should it have been
{First Col = 1}?

Another part:
'just move it up and overwrite anything there?
.Cells(iRow - 1, iCol).Value = .Cells(iRow, iCol).Value
Question:
No, not overwriting the X's that is already on the previous row. I
wanted to paste special, skip blanks, so that the data is not
overwritten. The X's will just keep adding up a row until all of the
X's (or 1's), all amalgamate onto the first row of the groupings.

So far, your code does delete the multiple names, leaving only 1
distinct name each. But, I am having trouble working around the
consolidating all of the X's from multiple lines into just one line for
each group.

Thanks Dave for helping me.

Ricky



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

The easy stuff first. The iCol/FirstCol only refer to the columns that should
be checked & merged. Since the first column is the key column, you wouldn't
want: bob,bob,bob as the result.

The difficult part.

Your second question:
Do you mean you want the values strung together:
x,x,1,x,1

Then this might work:

Option Explicit
Sub testme2()

Dim wks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long

Dim FirstCol As Long
Dim iCol As Long

Set wks = Worksheets("sheet1")

With wks
FirstRow = 2 'header row?
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 2 'names in column A

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
For iCol = FirstCol To _
.Cells(iRow, .Columns.Count).End(xlToLeft).Column
If IsEmpty(.Cells(iRow, iCol)) Then
'do nothing
Else
If IsEmpty(.Cells(iRow - 1, iCol)) Then
.Cells(iRow - 1, iCol).Value _
= .Cells(iRow, iCol).Value
Else
.Cells(iRow - 1, iCol).Value _
= .Cells(iRow - 1, iCol).Value _
& " ," & .Cells(iRow, iCol).Value
End If
End If
Next iCol
'delete this row with the same name
.Rows(iRow).Delete
End If
Next iRow
End With

End Sub

or if the row above is not empty, then keep it and don't change it?
Then this might work:

Option Explicit
Sub testme3()

Dim wks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long

Dim FirstCol As Long
Dim iCol As Long

Set wks = Worksheets("sheet1")

With wks
FirstRow = 2 'header row?
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 2 'names in column A

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
For iCol = FirstCol To _
.Cells(iRow, .Columns.Count).End(xlToLeft).Column
If IsEmpty(.Cells(iRow - 1, iCol)) = False Then
'do nothing
Else
'just move it up and overwrite anything there?
.Cells(iRow - 1, iCol).Value = .Cells(iRow, iCol).Value
End If
Next iCol
'delete this row with the same name
.Rows(iRow).Delete
End If
Next iRow
End With

End Sub

(Just check the cell above. If it's not empty, don't touch it.





Ricky Pang wrote:

Hi Dave,
I appreciate your response. The data in the cells would be either "X"s
or "1"s. After running your macro, I've elected to go with the "1"s
instead.

On your post:
With wks
FirstRow = 2 'header row? [Yes]
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 2 'names in column A
Question:
As the search criteria is based on Column A's names, should it have been
{First Col = 1}?

Another part:
'just move it up and overwrite anything there?
.Cells(iRow - 1, iCol).Value = .Cells(iRow, iCol).Value
Question:
No, not overwriting the X's that is already on the previous row. I
wanted to paste special, skip blanks, so that the data is not
overwritten. The X's will just keep adding up a row until all of the
X's (or 1's), all amalgamate onto the first row of the groupings.

So far, your code does delete the multiple names, leaving only 1
distinct name each. But, I am having trouble working around the
consolidating all of the X's from multiple lines into just one line for
each group.

Thanks Dave for helping me.

Ricky

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

--

Dave Peterson

Hi Dave,
To answer the second question:
No, I didn't want the values to be strung together within a single cell
ie, X,X,X...
Instead, I wanted to copy the last row, within the group, and paste the
values up one row. But I don't want to paste and overwrite the values.

So, the idea is to choose Paste Special instead and check the Skip
Blanks feature. This would then paste the X's, from the previous row,
onto the blank cells only. This way, I would retain the values and have
the bottom row's values add to the upper row on the blank cells only.
Thus, consolidating two rows into one.

Your Sub Testme1 didn't add up onto the blank cells. Testme 2 is for
stringing the values together. Unfortunately, not what I was looking
for. The result of Sub Testme3 didn't paste to blank cells either.

I know your macro is close. I just couldn't decipher where to make that
modification so that it'll only paste the X's onto the blank cells only?
(Then, delete the last row, loop the same name grouping, copy and paste
up one row, until all of the X's from the multiple rows are all on the
top row.)

Much appreciated, Dave.

Ricky


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

I'm still confused.

Say you start with this:

A B C D E
Bill 1 2
Bill 3 4 5
Bill 6 7
Sue 8
Sue 9
Bob 10 11
Bob 12 13

do you want to end up with this:
A B C D E
Bill 1 3 6 5 7
Sue 9 8
Bob 10 12 11 13

or:
A B C D E
Bill 1 2 4 5 7
Sue 9 8
Bob 10 12 11 13


If it's the first one, then use the first version (testme) of the macro.
If it's the second one, the use the 3rd version (testme3).

If it's something else, I'm more lost.

All of the routines just started at the bottom of column A and worked their way
up to the firstrow.

In testme:
If IsEmpty(.Cells(iRow, iCol)) Then
'do nothing
Else
'just move it up and overwrite anything there?
.Cells(iRow - 1, iCol).Value = .Cells(iRow, iCol).Value
End If

If the cell in the bottom row is empty, then don't do anything.
if the cell in the bottom row has something in it, then overwrite the cell
above.

In testme3:

If IsEmpty(.Cells(iRow - 1, iCol)) = False Then
'do nothing
Else
'just move it up and overwrite anything there?
.Cells(iRow - 1, iCol).Value = .Cells(iRow, iCol).Value
End If

If the cell above is not empty, then leave it alone.
If the cell above is empty, just plop the cell below into it.

(not too different, huh?)






Ricky Pang wrote:

Hi Dave,
To answer the second question:
No, I didn't want the values to be strung together within a single cell
ie, X,X,X...
Instead, I wanted to copy the last row, within the group, and paste the
values up one row. But I don't want to paste and overwrite the values.

So, the idea is to choose Paste Special instead and check the Skip
Blanks feature. This would then paste the X's, from the previous row,
onto the blank cells only. This way, I would retain the values and have
the bottom row's values add to the upper row on the blank cells only.
Thus, consolidating two rows into one.

Your Sub Testme1 didn't add up onto the blank cells. Testme 2 is for
stringing the values together. Unfortunately, not what I was looking
for. The result of Sub Testme3 didn't paste to blank cells either.

I know your macro is close. I just couldn't decipher where to make that
modification so that it'll only paste the X's onto the blank cells only?
(Then, delete the last row, loop the same name grouping, copy and paste
up one row, until all of the X's from the multiple rows are all on the
top row.)

Much appreciated, Dave.

Ricky

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

--

Dave Peterson