Sorting lists side by side to match variables

  • Thread starter Thread starter skyboy
  • Start date Start date
S

skyboy

Hello everyone,

I have a problem that I need to find a solution for. I have a list o
all the stores with a particular trait that carry my at least one of m
items. Then, I have a list for each item with all the stores tha
carry that particular item. What I want to do is sort this data s
that the store numbers under each item are matched up with th
corresponding store numbers in the master store list. I'll give you a
example of the problem.

Here is what the data looks like now:

Master Item 1 Item 2 Item 3 Item 4
1 2 3 1 3
2 4 2 4
3 4
4

And here is what I would like it to look like when I'm done:

Master Item 1 Item 2 Item 3 Item 4
1 1
2 2 2
3 3 3
4 4 4 4

This way I can easily -see- which stores carry which items. I shoul
note that not all of the stores under each item are in the master lis
- these I would like to filter out.
Is there a way to do this without going through each list and matchin
it up with the master list manually? This has become a very tim
consuming project that I am required to do over and over again wit
different traits, and I would appreciate it if someone could help me.

Thank you for your time,
Skybo
 
One way is to use a macro:

Option Explicit
Sub testme()

Dim mstrRng As Range
Dim myColRng As Range
Dim myColArr As Variant
Dim FirstCol As Long
Dim LastCol As Long
Dim iCol As Long
Dim wks As Worksheet
Dim iCtr As Long
Dim NewValRng As Range
Dim res As Variant

Set wks = Worksheets("sheet1")

With wks
FirstCol = 2
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

For iCol = FirstCol To LastCol
If Application.CountA(.Range(.Cells(2, iCol), _
.Cells(.Rows.Count, iCol))) = 0 Then
'do nothing
Else

Set mstrRng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))

Set myColRng = .Range(.Cells(2, iCol), _
.Cells(.Cells(.Rows.Count, iCol) _
.End(xlUp).Row, iCol))

If myColRng.Cells.Count = 1 Then
ReDim myColArr(1 To 1, 1 To 1)
myColArr(1, 1) = myColRng.Value
Else
myColArr = myColRng.Value
End If

myColRng.ClearContents

For iCtr = LBound(myColArr, 1) To UBound(myColArr, 1)
res = Application.Match(myColArr(iCtr, 1), mstrRng, 0)
If IsError(res) Then
Set NewValRng _
= .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
With NewValRng
.Value = myColArr(iCtr, 1)
.Offset(0, iCol - 1).Value = myColArr(iCtr, 1)
End With
Else
mstrRng(res).Offset(0, iCol - 1).Value _
= myColArr(iCtr, 1)
End If
Next iCtr
End If
Next iCol
End With

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
I found an easier way to accomplish this task using the vlooku
function. Thanks anyway.

Skybo
 
Back
Top