Need help creating macros

[Atom Oaks]

Hi there,

For whatever reason when our system compiles data into Excel 2003 it creates
a worksheet that looks like this (for example):

Purple Purple Purple Purple
Purple Green Green
Green
Blue Blue Blue Blue Red Red Red
Yellow Yellow Yellow Yellow
Yellow Orange
Orange Orange
Brown Brown Brown Brown Teal Teal Teal
Black Black Black Black Grey Grey Grey

I am hoping someone might be able to help me create a macros to combine the
duplicate rows together so that it looks like this:

Purple Purple Purple Purple Green Green Green
Blue Blue Blue Blue Red Red Red
Yellow Yellow Yellow Yellow Orange Orange Orange
Brown Brown Brown Brown Teal Teal Teal
Black Black Black Black Grey Grey Grey

While I would love a macros that could repair an entire worksheet (~25,000
rows) as you can see from my example, there is no discernible pattern between
single and duplicate rows. I would be happy with just a simple macros that
can combine the two rows and maybe I could attach it to a hotkey.

Any help would be greatly appreciated!

 

[Bernard Liengme]

No one answered. Maybe we cannot quite work out what is in the worksheet
Please add * at the end of each row as seen in worksheet
I do wish these newsreaders let us display cells better
best wishes

 

[Atom Oaks]

Oops, I didn't even realize the format got changed.
This is how my worksheet looks:

Purple Purple Purple Purple*
Purple //////// //////// //////// Green Green Green*
Blue Blue Blue Blue Red Red Red*
Yellow Yellow Yellow Yellow*
Yellow //////// //////// //////// Orange Orange Orange*
Brown Brown Brown Brown Teal Teal Teal*
Black Black Black Black Grey Grey Grey*

//////// = 1 blank cell
* = end of row

And I want to find and combine the duplicate rows in Column A like this:

Purple Purple Purple Purple Green Green Green
Blue Blue Blue Blue Red Red Red
Yellow Yellow Yellow Yellow Orange Orange Orange
Brown Brown Brown Brown Teal Teal Teal
Black Black Black Black Grey Grey Grey

So far, this is what I have come up with:

Sub CombineDelete()
'
' Macro2 Macro
' Macro recorded 1/8/2010 by Information Systems
'
' Keyboard Shortcut: Ctrl+q
'
Range(ActiveCell, ActiveCell.Offset(0, 3)).Select
Selection.Cut
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 0).Select
Selection.EntireRow.Delete
End Sub

It does what I intended but requires me to manually look for the duplicates.
So any input how I can fix that would be greatly appreciated. Hopefully
this post is much better than my last. Sorry!

 

[Atom Oaks]

Oops, I did not notice that format had changed after I posted. This is an
example of how my worksheet looks:

Purple Purple Purple Purple*
Purple //////// //////// //////// Green Green Green*
Blue Blue Blue Blue Red Red Red*
Yellow Yellow Yellow Yellow*
Yellow //////// //////// //////// Orange Orange Orange*
Brown Brown Brown Brown Teal Teal Teal*
Black Black Black Black Grey Grey Grey*

//////// = 1 blank cell
* = end of row

And I am trying to locate and combine all of the duplicate rows in Column A
so that my worksheet looks like this:

Purple Purple Purple Purple Green Green Green*
Blue Blue Blue Blue Red Red Red*
Yellow Yellow Yellow Yellow Orange Orange Orange*
Brown Brown Brown Brown Teal Teal Teal*
Black Black Black Black Grey Grey Grey*

So far, this is what I have come up with:

Sub CombineDelete()
'
' Macro2 Macro
' Macro recorded 1/8/2010 by Information Systems
'
' Keyboard Shortcut: Ctrl+q
'
Range(ActiveCell, ActiveCell.Offset(0, 3)).Select
Selection.Cut
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 0).Select
Selection.EntireRow.Delete
End Sub

It does what I intended but requires that I manually locate the duplicates
in Column A. So any ideas would be greatly appreciated. Hopefully, this
post is a lot better. Sorry!

 

[Rick Rothstein]

I think you will need to give us just a little more information about how
your data is structured if you want a complete solution (remember, you know
all about how your data is arranged and we here have no idea about it
whatsoever... all we know is what you tell us). Here are some of the
questions I have...

1. Will the first occurrence of a color always be repeated 4 times as all
your example data shows?

2. Will a second row for a repeated color (in the first column) always have
three blank cells following the color as your example data shows? If not,
then will there always be at least one blank cell following the second
mention of the color in the first column?

3. Can there be more than two rows for a given color repeated in the first
column (that is, in your example, could the be another row starting with the
color Purple in addition to the two you already show)?

4. Will all the mulit-row colors (shown in the first column) be grouped next
to each other as your example shows, or could they be scattered all about
with other colors in-between them?

 

[Atom Oaks]

Sorry, I did not realize that the format changed after I posted. This is how
my worksheet looks:

Purple Purple Purple Purple*
Purple " " " Green Green Green*
Blue Blue Blue Blue Red Red Red*
Yellow Yellow Yellow Yellow*
Yellow " " " Orange Orange Orange*
Brown Brown Brown Brown Teal Teal Teal*
Black Black Black Black Grey Grey Grey*

" = 1 blank cell
* = end of row

And I am trying to find and combine all the duplicate rows in Column A so
that my work sheet looks like this:

Purple Purple Purple Purple Green Green Green*
Blue Blue Blue Blue Red Red Red*
Yellow Yellow Yellow Yellow Orange Orange Orange*
Brown Brown Brown Brown Teal Teal Teal*
Black Black Black Black Grey Grey Grey*

So far, this is what I have come up with:

Sub CombineDelete()
'
' Macro2 Macro
' Macro recorded 1/8/2010 by Information Systems
'
' Keyboard Shortcut: Ctrl+q
'
Range(ActiveCell, ActiveCell.Offset(0, 10)).Select
Selection.Cut
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 0).Select
Selection.EntireRow.Delete
End Sub

It does the job, but requires that I manually locate the duplicates and use
a hotkey. So any ideas would be greatly appreciated. Hopefully this post is
much better. Thank you!

 

[Bernard Liengme]

Hi,
This is not very sophisticated but seems to work with the data you provided.

Sub tryme()
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For j = 1 To LastRow
LastCol = Cells(j, Columns.Count).End(xlToLeft).Column
If LastCol < 7 Then
Range(Cells(j + 1, 1), Cells(j + 1, 10)).Copy Destination:=Cells(j, 5)
Cells(j + 1, "A") = "VOID"
LastCol = Cells(j, Columns.Count).End(xlToLeft).Column
For k = LastCol To 1 Step -1
If IsEmpty(Cells(j, k)) Then
Cells(j, k).Delete Shift:=xlToLeft
End If
Next k
End If
Next j

'delete marked rows
For j = LastRow To 1 Step -1
If Cells(j, "A") = "VOID" Then
Rows(j).EntireRow.Delete
End If
Next j

best wishes