Matching Multiple Columns

D

davidstillwell

I'm trying to create a Formula that will search within multiple columns
and lineup by rows any data in the the columns that are a match. As an
example data would be in four columns that do not have equal number of
and the same exact content to start
A B C
1234 7777 2424
8888 9999 1111
7777 2424 1234
2424 1234 7777
3333 4444 5555
After performing function the data would be sorted to
A B C
1234 1234 1234
2424 2424 2424
3333
4444
5555
7777 7777 7777
8888
9999


Any Suggestions?
 
J

JLatham

Well, I for one cannot come up with a worksheet function or group of
functions that would do that for you, but I can come up with some VBA code to
accomplish it.

Works with any number of columns, just redefine the DataColumns() array and
fill the elements with column identifiers at the start of the code. Change
the variable FirstDataRow to point to the first row of your data to
manipulate. That allows you to have column headers if needed. Hope this
helps. It does kind of assume that your data is numeric - if it is text, you
may end up with the column header text (if there is any) mixed into the data
somewhere along the line. For numeric data, it works with or without column
headers.
Functional workbook at: http://www.jlathamsite.com/uploads/for_DStillwell.xls
jlatham: (e-mail address removed)

Sub SegregateData()
'set up for 3 columns
'dimension this array to hold the column identifier for
'each column that holds information
Dim DataColumns(1 To 3) As String
'load up the array elements
DataColumns(1) = "A"
DataColumns(2) = "B"
DataColumns(3) = "C"
Const HelperColumn = "D" ' any empty column
Const FirstDataRow = 2 ' first row with data to alter

Dim anyAddress As String
Dim LC As Integer ' loop counter
Dim colOffset As Integer
Dim SafetyBelt As Long

Application.ScreenUpdating = False ' for speed
'begin by sorting each column individually
For LC = LBound(DataColumns) To UBound(DataColumns)
Columns(DataColumns(LC) & ":" & DataColumns(LC)).Select
anyAddress = DataColumns(LC) & "1"
Selection.Sort Key1:=Range(anyAddress), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Next
'
'now the work begins
'we are going to create a helper column
'and put all of the information from all columns into it
'and then sort it and remove duplicate entries
'
'make sure the helper column is empty
Columns(HelperColumn & ":" & HelperColumn).Select
Selection.ClearContents
'fill up any cells in helper column to
'make data placed here start at same row as data does
If FirstDataRow > 1 Then
Do Until ActiveCell.Row = FirstDataRow
ActiveCell = "Header"
ActiveCell.Offset(1, 0).Activate
Loop
End If
For LC = LBound(DataColumns) To UBound(DataColumns)
If LC > 1 Then
'for all columns after the 1st one
Range(DataColumns(LC) & FirstDataRow).Select
anyAddress = DataColumns(LC) & FirstDataRow & _
":" & Range(DataColumns(LC) & _
"65536").End(xlUp).Address
Range(anyAddress).Select
Selection.Copy
Range(HelperColumn & FirstDataRow).End(xlDown).Offset(1, 0).Select
Else
' just done for the 1st group
Range(DataColumns(LC) & FirstDataRow).Select
anyAddress = DataColumns(LC) & FirstDataRow & _
":" & Range(DataColumns(LC) & "65536").End(xlUp).Address
Range(anyAddress).Select
Selection.Copy
Range(HelperColumn & FirstDataRow).Select
End If
ActiveSheet.Paste
Next
Application.CutCopyMode = False
'now sort the helper column
Columns(HelperColumn & ":" & HelperColumn).Select
anyAddress = HelperColumn & FirstDataRow
Selection.Sort Key1:=Range(anyAddress), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range(anyAddress).Select ' to top of the helper column
SafetyBelt = Range(HelperColumn & "65536").End(xlUp).Row
'remove duplicates from the HelperColumn
Do Until IsEmpty(ActiveCell)
If ActiveCell = ActiveCell.Offset(1, 0) Then
ActiveCell.Offset(1, 0).Delete Shift:=xlUp
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop
'
'now have to move things down in the individual columns
'
For LC = LBound(DataColumns) To UBound(DataColumns)
colOffset = Range(HelperColumn & FirstDataRow).Column - _
Range(DataColumns(LC) & FirstDataRow).Column
Range(DataColumns(LC) & FirstDataRow).Select
Do Until IsEmpty(ActiveCell) Or ActiveCell.Row > SafetyBelt
If ActiveCell > ActiveCell.Offset(0, colOffset) Then
'move this down
Selection.Insert Shift:=xlDown
End If
'check next entry
ActiveCell.Offset(1, 0).Activate
Loop
Next
'should be done now!
'get rid of the helper column contents
Columns(HelperColumn & ":" & HelperColumn).Select
Selection.ClearContents
Application.ScreenUpdating = True
Range(DataColumns(1) & "1").Select ' to top of 1st column
End Sub
 
D

davidstillwell

Wow! I think Imay have gotten in a bit over my head, but I'll see if
I can fugure out how to utilize the VBA code. Thank You for your
response.
 
J

JLatham

You can either cut the code from the posting here and paste it into a regular
code module in a workbook, or you can download the functional workbook and
put your data into a sheet there and use Tools | Macro | Macros to run the
code after making changes to the array size/contents and definition of the
first row with data in it within the code. To quickly get into the VB Editor
to do that, just open the workbook and press [Alt]+[F11]
 
P

PapaDos

It can be done wih worksheet functions only, but it is a bit difficult to
modify/maintain.

Assuming your data is in $A$2:$C$6 and that you want the results starting at
$A$10, enter this formula in $A$10

=IF(((ROWS(A$9:A9) - 1) * COLUMNS($A$2:$C$6)) - COUNTBLANK($A$9:$C9) +
COUNTBLANK($A$9:$C$9) < COUNT($A$2:$C$6), IF(SMALL(A$2:A$6,
MIN(ROWS(A$2:A$6), ISBLANK(A$9) + ROWS($A$9:A9) - COUNTBLANK(A$9:A9))) =
SMALL($A$2:$C$6, 1 + ((ROWS(A$9:A9) - 1) * COLUMNS($A$2:$C$6)) -
COUNTBLANK($A$9:$C9) + COUNTBLANK($A$9:$C$9)), SMALL(A$2:A$6, ISBLANK(A$9) +
ROWS($A$9:A9) - COUNTBLANK(A$9:A9)), ""), "")

Fill right and down as needed...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top