Does anybody have code to do this?

M

Michael Beckinsale

Hi All,

I dont know how to explain this so here is the example.

This contains 2 lists.
List1 is column A&B unique ID in A.
List2 is column C&D unique ID in B.
A B C D
1 Value 1 Apples Value 2 Basket 2
2 Value 2 Pears Value 3 Basket 3
3 Value 4 Oranges Value 5 Basket 5
4 Value 6 Bananas Value 6 Basket 6
5 Value 7 Figs Value 8 Basket 8


I would like to run a routine so the result is as follows:
A B C D
1 Value 1 Apples
2 Value 2 Pears Value 2 Basket 2
3 Value 3 Basket 3
4 Value 4 Oranges
5 Value 5 Basket 5
6 Value 6 Bananas Value 6 Basket 6
7 Value 7 Figs
8 Value 8 Basket 8

Does anybody have any code that does something like the above or can point
me in the right direction?

The list is likely to contain up to 2000 rows and may have more that 1
column which is an attribute of the unique ID.

Any help gratefully received

Regards

Michael Beckinsale
 
B

Bob Phillips

Sub Test()
Dim iLastRow As Long
Dim i As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 1 Step -1
If Cells(i + 1, "A").Value = Cells(i, "C").Value Then
Cells(i, "C").Resize(, 2).Copy Cells(i + 1, "C")
ElseIf Cells(i, "A").Value < Cells(i, "C").Value Then
Rows(i + 1).Insert
Cells(i, "C").Resize(, 2).Copy Cells(i + 1, "C")
Cells(i, "C").Resize(, 2).ClearContents
End If
Next i

End Sub



--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
M

michael.beckinsale

Bob,

Many thanks. I will give it a try and get back to you.

If the columns with the attributes are more than 1 can l just increase
the number? ie i+1 becomes i+7

Regards
 
M

michael.beckinsale

Bob,

I have tried the code you provided and it works fine except the 1st
line which should NOT contain Value2 Basket2 in columns C&D
respectively. Below is the result of running your code on the example
posted. Any ideas?

Value 1 Apples Value 2 Basket 2
Value 2 Pears Value 2 Basket 2
Value 3 Basket 3
Value 4 Oranges
Value 5 Basket 5
Value 6 Bananas Value 6 Basket 6
Value 7 Figs
Value 8 Basket 8

TIA

Regards
 
G

Guest

this appears a bit more robust.

Sub ABC()
Dim i As Long
i = 1
Do Until IsEmpty(Cells(i, 1)) _
Or IsEmpty(Cells(i, 3))
If Cells(i, 1) > Cells(i, 3) Then
Cells(i, 1).Resize(, 2).Insert xlShiftDown
ElseIf Cells(i, 1) < Cells(i, 3) Then
Cells(i, 3).Resize(, 2).Insert xlShiftDown
End If
i = i + 1
Loop
End Sub

If you have more columns to check, then it would be more complex, but the
same algorithm would be used. How many columns would need to be checked and
are the in groups of 2?
 
M

Michael Beckinsale

Tom,

In the specific worksheet l need to apply this to:

List 1 is from Column B to Column M. The unique ID is in column B and the
attributes are in columns C to M. (12 columns in all, 1 for ID, 11 for
attributes)
List 2 is from Column X to Column AA The unique ID is in column X and the
attributes are in columns Y to AA. (4 columns in all, 1 for ID, 3 for
attributes)

So the purpose of the code is to match the unique ID's and move the
attributes accordingly. Hope this makes sense.

The code you sent me for the example posted works fine but if you could
amend it to accomodate the above it would be awesome.

I really appreciate the effort yourself and BOB have put into this as it
will really save a lot of time, effort and frustration.(and hopefully
countless errors)

I am quite surprised that this technique / code is not more widely known on
the newsgroups because it would seem to me that it could be widely applied
to many list matching exercises such as bank reconcilliations etc. It is
much simpler to operate than the many solutions available using array
formulas etc.

Anyway many thanks in advance

Regards
 
G

Guest

Sub ABC()
Dim i As Long
i = 1
Do Until IsEmpty(Cells(i, "B")) _
Or IsEmpty(Cells(i, "X"))
If Cells(i, "B") > Cells(i, "X") Then
Cells(i, "B").Resize(, 12).Insert xlShiftDown
ElseIf Cells(i, "B") < Cells(i, "X") Then
Cells(i, "X").Resize(, 4).Insert xlShiftDown
End If
i = i + 1
Loop
End Sub

See what this does. (obviously test it on a copy of your data). If
problems, post back.

I have posted a version of it more than once; as far back probably as around
1999 or perhaps earlier. but there is nothing distinctive about the code
itself to search on in Google or the old Deja News. Matching lists or
comparing list would probably be too vague to search on. I will admit the
first time I tried to solve it I came up with a much hairier algorithm.
 
M

michael.beckinsale

Tom,

Perfectly understand what you mean by the problem being "searchable".
However it is one of those solutions which would be invaluable if it
was posted on one or many MVP's websites. Better still make it
available directly from Excel!

The code works fine. Many, many thanks.

I assume that l can adapt it quite easily to be more flexible for
future use. I am thinking of using input boxes for the user (mainly
me!) to input say the following:

List1 Unique ID column.........assigned to string variable
List1 No of Columns.............assigned to integer variable
List2 Unique ID column.........assigned to string variable
List2 No of Columns.............assigned to integer variable

l was thinking of making a UDF but l'm not sure that it really lends
itself to that. Anyway l always seem to have problems creating UDF's. I
need to practice!

Can you see any problems in doing the above?

Once again many thanks

Regards
 
G

Guest

No, as long as the user doesn't make a mistake. If the areas are
distinctive, then it might be safer to sense the areas, then ask for
corrections. "sensing" the areas would depend on how they are distinctive.
For example, if it was two tables separated by at least one empty column and
starting in row1 (no empty cells in the top row of attributes)

Dim rng As Range
Set rng = Rows(1).SpecialCells(xlConstants)
MsgBox rng(1).Column & " - " & rng.Areas(1).Count & _
vbNewLine & _
rng.Areas(2)(1).Column & " - " & rng.Areas(2).Count


as an example.
 
M

michael.beckinsale

Tom,

Thanks for the suggestion. Would you mind having a look at the finished
article when it is done?

If so shall l repost here or send direct to you?

TIA
 

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

Top