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
382 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

Best Practices: Disaster Recovery Testing

Besides backup, any IT division should have a disaster recovery plan. You will find a few tips below relating to the development of such a plan and to what issues one should pay special attention in the course of backup planning.

Question has a verified solution.

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

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

803 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