Find repeat and than merge and centre

H

Hardeep_kanwar

Hi!

How to find repeated data and then merge and centre.

My data is from A to M.Range from A1 to M4500

Any Function Or Macro.

Thanks
Hardeep
 
S

ShaneDevenshire

Hi,

I think we need more detail - what do you want to merge and center, multiple
rows, multiple columns, multiple blocks of cells? You will loose the data in
all but one of the merged cells, Excel does not merge the data.

What determines if a range has repeat data - does the data in two cells
above each other need to be the same, does all the data on two adjacent rows
need to be the same, do the rows with duplicate data need to be adjacent?
 
H

Hardeep_kanwar

A B C D
1 HR 500 200 500
2 HR 500 200 500
3 WP 1000 500 1000
4 DP 200 50 200
5 DP 200 50 200
I want like this
A B C D
1 HR 500 200 500
2
3 WP 500 200 500
4 DP 200 50 200
5

NOTE:cell A1 and A2,B1 -B2,C1-C2,D1-D2 is Merged and Centre. The data in
A1-A2,B1-B2,C1-C2,D1-D2 is same.
Or you may say that The rows are same it may goes to 3 or 4 or 7 rows are
same data. And i want to merge and centre the same data in the rows.
Merge and Centre option is on the toolbar.

Thanks

Hardeep Kanwar

:
 
G

Gord Dibben

Hardeep

Run this macro based upon contents of Column A

Sub Clear_Stuff()
'Based on code by Sandy Mann July 1st, 2007
Dim LastRow As Long
Dim x As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False

For x = LastRow To 2 Step -1
If Cells(x, 1).Value = Cells(x - 1, 1).Value Then
If Cells(x - 1, 1).Value <> "" Then
If Cells(x - 1, 1).Value <> "" Then
Cells(x, 1).EntireRow.ClearContents
End If
End If
End If
Next x
Application.ScreenUpdating = True
End Sub

Does not merge and center, but clears contents of duplicated row.

You don't want merge and center because only the data in the top left cell of
selected cells will remain.

i.e. if you selected A2:D2 and merged, only A2 data would remain.


Gord Dibben MS Excel MVP
 
H

Hardeep_kanwar

Yes, exactly i want this but i want to merge and centre a1:a2 or b1:b9
because the data is same. MY boss want not to delete repeated data but merge
and centre the same data.
 
G

Gord Dibben

I guess I just don't understand what your boss means by "merge and center the
same data"

Merge and center A1:A2 will delete the data in A2.


Gord
 
H

Hardeep_kanwar

So what, it does't matter for me If A2 is deleted Because the data is same.If
the data is not same then this is the problem for me. My question is not to
deleted repeated data but merge and centre the data.


Just see my example


Thanks
hardeep


Gord Dibben said:
I guess I just don't understand what your boss means by "merge and center the
same data"

Merge and center A1:A2 will delete the data in A2.


Gord
Click to expand...
HR 500 200 500
HR 500 200 500
WP 1000 500 1000
DP 200 50 200
DP 200 50 200HR 500 200 500

WP 500 200 500
DP 200 50 200
 
G

Gord Dibben

So what??

Getting a little testy are we?

Sub Clear_Stuff()
'Based on code by Sandy Mann July 1st, 2007
Dim LastRow As Long
Dim x As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For x = LastRow To 2 Step -1
If Cells(x, 1).Value = Cells(x - 1, 1).Value Then
If Cells(x - 1, 1).Value <> "" Then
If Cells(x - 1, 1).Value <> "" Then
Cells(x - 1, 1).Resize(2).MergeCells = True
Cells(x - 1, 2).Resize(2).MergeCells = True
Cells(x - 1, 3).Resize(2).MergeCells = True
Cells(x - 1, 4).Resize(2).MergeCells = True

End If
End If
End If
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

I hope your boss likes his merged and centered cells which will cause him no end
of grief in the future if tries to copy, paste, sort, filter or many other
operations that won't work with merged cells.


Gord
 
H

Hardeep_kanwar

Dear Sir,
Thanks for Code, but unfortunatally it work on some cells not in all cells
I want to give the attach file.
So. pls provide me your e-mail id

Thanks once more for the code

Hardeep kanwar
 
G

Gord Dibben

I have to admit that is beyond my skills in VBA.

Maybe someone else will download and fix you up.

Could I ask.......what is the purpose of the "merge and center" when autofilter
could just return unique rows?


Gord
 
S

Sandy Mann

I am not saying that my programming skills are any better than Gord's but
try this simple minded Macro:

Option Explicit
Sub MergeItandCentre()
Dim LastRow As Long
Dim LineRow As Long
Dim cCell As Long
Dim Col As Long
Dim N As Integer

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Application.DisplayAlerts = False
Application.ScreenUpdating = False

For LineRow = 1 To LastRow - 1
For Col = 1 To 11
If Cells(LineRow, Col).Value = _
Cells(LineRow + 1, Col).Value Then
N = N + 1
End If
Next Col

If N = 11 Then
For cCell = 1 To 11
With Range(Cells(LineRow, cCell), Cells(LineRow + 1, cCell))
.MergeCells = True
.VerticalAlignment = xlCenter
End With
Next cCell
End If

N = 0

Next LineRow

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub



--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

[email protected]
Replace @mailinator.com with @tiscali.co.uk
 
G

Gord Dibben

Very good Sandy.

Hardeep note: rows 3 and 4 are not merged and centered as per your "I want
this" because C3 and C4 are not the same.

221000400739-1
221000400739-2


Gord
 
S

Sandy Mann

Not so good - I downloaded the first file not the OP's corrected download.
I will need to look at it again.

--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

[email protected]
Replace @mailinator.com with @tiscali.co.uk
 
S

Sandy Mann

This seems to work but I would have thought that hiding the Columns and
diplicate Rows would have been a betetr option because then there would be
no loss of data.

Option Explicit
Sub MergeItandCentre()
Dim LastRow As Long
Dim LineRow As Long
Dim cCell As Long
Dim Col As Long
Dim N As Integer
Dim CellValue1
Dim CellValue2

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Columns("A:A").EntireColumn.Hidden = True
Columns("E:G").EntireColumn.Hidden = True

For LineRow = LastRow To 2 Step -1
For Col = 2 To 13
If (Col >= 4 And Col < 8) Then GoTo skip
CellValue1 = Cells(LineRow, Col).Value
CellValue2 = Cells(LineRow + 1, Col).Value
If Col = 3 Then
CellValue1 = Left(CellValue1, 12)
CellValue2 = Left(CellValue2, 12)
End If
If CellValue1 = CellValue2 Then
N = N + 1
End If
skip:
Next Col

If N = 8 Then
For cCell = 1 To 13
With Range(Cells(LineRow, cCell), Cells(LineRow + 1, cCell))
.MergeCells = True
.VerticalAlignment = xlCenter
End With
Next cCell
End If

N = 0

Next LineRow

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub



--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

[email protected]
Replace @mailinator.com with @tiscali.co.uk
 
S

Sandy Mann

You are verywelcome, glad that it worked for you

--

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

[email protected]
Replace @mailinator.com with @tiscali.co.uk
 
H

Hardeep_kanwar

Dear Sir,

Sorry to disturb u again

http://www.savefile.com/files/1578364

Kindly find the attached file. I had received this original data from my
boss now I will tell u what I want.



Firstly, Merge and centre the Yellow color rows.

Secondly, copy the data Zone wise For example Cz001 in another workbook
sheet1, Cz002 in sheet 2, CZ003 in sheet3, Nz001 in Another workbook
sheet1.Nz002 in sheet2,Ez001 in another sheet1 and so on.



I hope this time you will help me



Regards,

Hardeep kanwar
 
Top