Solved

merge cells (on a Excell sheet) of selected columns , and only the duplicated values with the sign ; in between the merged cells!

Posted on 2013-01-19
3
373 Views
Last Modified: 2013-01-20
merge cells (on a Excell sheet) of selected columns , and only the duplicated values with the sign ; in between the merged cells!

I want to merge cells on excel 2007  but the conditions are :
      1.  only from 2 selected columns of a sheet say "AA"  &  "BF",
           independent of the number of columns. IN starting row "2"
      2.  Find only the duplicated values on the "AA" and merge only the opposite value          (the other value right or left)
      3.  with a sign ";" in "red" color between the merged values in the cell
      4.  the values  to be in <<orange>> the 2nd , in <<blue>> the 3rd ,the 4rth in ......
      5.  and bold all of the cell values that is merged      
      6.  clear content & highlight with background color with in row after merged
      7.  stop macro when in "AA" column   finds cell that is empty.

I have  26 columns , 8000 rows  of data
thanks anyone that helps
see example
merge-dup-cell---compare2.xlsx
0
Comment
Question by:tonyantony
3 Comments
 
LVL 29

Expert Comment

by:gowflow
ID: 38796764
Can we give you the result in a separate sheet ? as here u have them in the same sheet. also what are the colors afterthe 3rd you put ... ? we chose a diffrent color you mean ???
Don't you think that the colors + background yellow is a bit too much to distinguish the colors ?? If you don't mind I would decide either
Keep the yellow baground and not put colors by duplicate

OR

Remove the yellow background and keep the colors by duplicate.

Last but not least I presume what you want is to select the 2 columns and then press on a button and the macro will produce the results based on what you selected. Is that right ?

Pls advise.
gowflow
0
 
LVL 18

Accepted Solution

by:
krishnakrkc earned 500 total points
ID: 38797880
Hi


Sub kTest()
    
    Dim FC, MC, i As Long, Colors, x, n As Long, c As Long
    Dim dic As Object, MergeCol As Range, j As Long, MRC, MRA As String
    
    Colors = Array(0, 16711680, 5287936, 13369446, 49407) '<< add more colors
    
    Const FirstCol = "B"    '<< adjust to suit
    Const MyRangeAddress = "A:F"   '<< adjust to suit
    
    Set MergeCol = Application.InputBox("Select the Range to be MERGED", Type:=8)
    
    With MergeCol
        MRA = .Parent.Range(CStr(Split(MyRangeAddress, ":")(0) & .Row & ":" & _
                        Split(MyRangeAddress, ":")(1) & .Row + .Rows.Count - 1)).Address
        MRC = .Parent.Range(MRA).Value2
        FC = .Parent.Range(FirstCol & .Row).Resize(.Rows.Count).Value2
    End With
    
    MC = MergeCol.Value2
    
    Set dic = CreateObject("scripting.dictionary")
        dic.comparemode = 1
    
    For i = UBound(FC, 1) To 1 Step -1
        If Len(FC(i, 1)) Then
            If Not dic.exists(FC(i, 1)) Then
                dic.Item(FC(i, 1)) = i
            Else
                j = dic.Item(FC(i, 1))
                For c = 1 To UBound(MRC, 2)
                    MRC(j, c) = Empty
                Next
                MC(i, 1) = MC(i, 1) & ";" & MC(j, 1)
                MC(j, 1) = Empty
                dic.Item(FC(i, 1)) = i
            End If
        End If
    Next
    
    MergeCol.Parent.Range(MRA) = MRC
    
    With MergeCol
        .Value = MC
        For i = 1 To UBound(MC, 1)
            If InStr(1, MC(i, 1), ";") Then
                x = Split(MC(i, 1), ";")
                With .Cells(i, 1)
                    n = 1: c = 0
                    For j = 0 To UBound(x)
                        If j > UBound(Colors) Then c = 0
                        .Characters(n, Len(x(j))).Font.Color = Colors(c)
                        .Characters(Len(x(j)) + n, 1).Font.Color = 255
                        n = n + Len(x(j)) + 1
                        c = c + 1
                    Next
                    .Font.Size = 12
                    .Font.Bold = True
                    .Interior.Color = vbYellow
                End With
            End If
        Next
    End With
    
End Sub

Open in new window


Kris
0
 

Author Closing Comment

by:tonyantony
ID: 38799346
Thanks , i have test it , excellent work
you save me many hours of work
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

912 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now