See who's quickest at solving this
 

Malcolm,

I solved this last week - for somebody else, but do I get a prize for being
fastest <vbg?

Try the code below. Change the xlNo to xlYes (in two places) and the 1 to a
2 in "For row = 1 To...." if you have a header row.

HTH,
Bernie
MS Excel MVP

Sub Macro1()
Dim myCell As Range
Dim row As Long

Range("A:B").Sort key1:=Range("A1"), _
order1:=xlAscending, _
header:=xlNo
Range("C:D").Sort key1:=Range("C1"), _
order1:=xlAscending, _
header:=xlNo

For row = 1 To Application.CountA(Range("A:A"))
If Cells(row, 3).Value < Cells(row, 1).Value Then
Cells(row, 3).Resize(1, 2).Insert Shift:=xlDown
End If
Next row
End Sub



"Malcolm Davidson" wrote in message
...
Hi

An intersting problem and one I get every 2 months, so help here would be
greatly appreciated.

Every 2 months we receive a spreadsheet with new loans that our current
clients are entitled to. The problem is, there always seems to be some
irritating problems that are quite time consuming.

Is it possible to have a spreadsheet with 795 employees with employee ID
as the unique Key in column A, his name in column B and then the new
entitled loan recipients pasted into the sheet with the ID in column C and
the name in Column D. There may only be 500 of the recipients entitled to
the loan so there will be 2 columns (A & B) with 795 rows and 2 columns (C &
D) with 500 rows.

All 500 in column C & D will be in columns A & B but will obviously be out
of line.

I would like to know if there is a macro or function I could run where the
employee ID in column C can line up with it's corresponding Employee ID in
column A, obviously bringing the name in Column D with it. This will mean
inserting blank cells where needed in columns C & D.

I'm baffled just writing this so I hope you can understand what I am
trying to achieve.

Thanks in advance.

M Davidson

See who's quickest at solving this
 

Thanks Bernie

You have pointed me in the right direction. I was wrong about a few things I put down in my initial request yesterday.

Column A & B has 564 emplyees and there are 447 that need to be compared from columns C &

I initally thought that all in Columns C & D would be in A & B somewhere. I was wrong. So, I also need the ability to insert blank cells in certain rows in column A & B. (Employee ID's are sorted in Ascending order

This is the code I slightly ammended from your reply to try and resolve this

There is still aproblem I need to resolve which I will explain after the code

Sub Macro(
Dim myCell As Rang
Dim row As Lon

Range("A:B").Sort key1:=Range("A1"), order1:=xlAscending, header:=xlN
Range("C:D").Sort key1:=Range("C1"), order1:=xlAscending, header:=xlN

For row = 1 To Application.Count(Range("A:A")
If Cells(row, 3).Value < Cells(row, 1).Value And Cells(row, 1).Value < Cells(row, 3).Value The
Cells(row, 3).Resize(1, 2).Insert Shift:=xlDow
Els
If Cells(row, 3).Value < Cells(row, 1).Value And Cells(row, 1).Value Cells(row, 3).Value The
Cells(row, 1).Resize(1, 2).Insert Shift:=xlDow
End I
End I
Next ro
End Su

My problem is, once this reaches row 556 the program seems to stop doing its thing and the remainder of the employees are not lined up. Bare in mind that due to blank spaces being inserted, column A employees are shifting below row 556

How can I get the program to carry on lining up the employees below the original last employee row

Does this make sense

Thanks in advanc

Malcolm Davidson

See who's quickest at solving this
 

Malcolm Davidson,

This code will first add new entries in colC:D to the end of colA:B

Sub Macro()
Dim myCell As Range
Dim row As Long
Dim OldListLR As Long
Dim NewListLR As Long
Dim NewEntry As Long

OldListLR = Range("A" & Rows.Count).End(xlUp).Row
NewListLR = Range("C" & Rows.Count).End(xlUp).Row
For Row = 1 To NewListLR
NewEntry = Evaluate("=countif(" _
& Range("A1:A" & OldListLR).Address _
& "," & Range("C" & Row).Address & ")")
If NewEntry = 0 Then
Cells(Row, 3).Resize(1, 2).Copy _
Destination:=Cells(OldListLR + 1, 1)
OldListLR = OldListLR + 1
End If
Next Row

Range("A:B").Sort key1:=Range("A1"), order1:=xlAscending, header:=xlNo
Range("C:D").Sort key1:=Range("C1"), order1:=xlAscending, header:=xlNo

For row = 1 To OldListLR
If Cells(row, 3).Value < Cells(row, 1).Value Then
Cells(row, 3).Resize(1, 2).Insert Shift:=xlDown
End If
Next row
End Sub

HTH
Cecil

"Malcolm Davidson" wrote in message
...
Thanks Bernie.

You have pointed me in the right direction. I was wrong about a few
things I put down in my initial request yesterday.

Column A & B has 564 emplyees and there are 447 that need to be compared
from columns C & D

I initally thought that all in Columns C & D would be in A & B somewhere.
I was wrong. So, I also need the ability to insert blank cells in certain
rows in column A & B. (Employee ID's are sorted in Ascending order)

This is the code I slightly ammended from your reply to try and resolve
this.

There is still aproblem I need to resolve which I will explain after the
code.

Sub Macro()
Dim myCell As Range
Dim row As Long

Range("A:B").Sort key1:=Range("A1"), order1:=xlAscending, header:=xlNo
Range("C:D").Sort key1:=Range("C1"), order1:=xlAscending, header:=xlNo

For row = 1 To Application.Count(Range("A:A"))
If Cells(row, 3).Value < Cells(row, 1).Value And Cells(row, 1).Value
< Cells(row, 3).Value Then
Cells(row, 3).Resize(1, 2).Insert Shift:=xlDown
Else
If Cells(row, 3).Value < Cells(row, 1).Value And Cells(row,
1).Value Cells(row, 3).Value Then
Cells(row, 1).Resize(1, 2).Insert Shift:=xlDown
End If
End If
Next row
End Sub

My problem is, once this reaches row 556 the program seems to stop doing
its thing and the remainder of the employees are not lined up. Bare in mind
that due to blank spaces being inserted, column A employees are shifting
below row 556.

How can I get the program to carry on lining up the employees below the
original last employee row?

Does this make sense.

Thanks in advance

Malcolm Davidson

See who's quickest at solving this
 

Malcolm,

Assuming the rest of your logic works, you could simply change

For row = 1 To Application.Count(Range("A:A"))

to

For row = 1 To Application.Count(Range("A:B"))
If Cells(row,1).Value ="" And Cells(row,3).Value = "" then exit sub

HTH,
Bernie
MS Excel MVP

"Malcolm Davidson" wrote in message
...
Thanks Bernie.

You have pointed me in the right direction. I was wrong about a few
things I put down in my initial request yesterday.

Column A & B has 564 emplyees and there are 447 that need to be compared
from columns C & D

I initally thought that all in Columns C & D would be in A & B somewhere.
I was wrong. So, I also need the ability to insert blank cells in certain
rows in column A & B. (Employee ID's are sorted in Ascending order)

This is the code I slightly ammended from your reply to try and resolve
this.

There is still aproblem I need to resolve which I will explain after the
code.

Sub Macro()
Dim myCell As Range
Dim row As Long

Range("A:B").Sort key1:=Range("A1"), order1:=xlAscending, header:=xlNo
Range("C:D").Sort key1:=Range("C1"), order1:=xlAscending, header:=xlNo

For row = 1 To Application.Count(Range("A:A"))
If Cells(row, 3).Value < Cells(row, 1).Value And Cells(row, 1).Value
< Cells(row, 3).Value Then
Cells(row, 3).Resize(1, 2).Insert Shift:=xlDown
Else
If Cells(row, 3).Value < Cells(row, 1).Value And Cells(row,
1).Value Cells(row, 3).Value Then
Cells(row, 1).Resize(1, 2).Insert Shift:=xlDown
End If
End If
Next row
End Sub

My problem is, once this reaches row 556 the program seems to stop doing
its thing and the remainder of the employees are not lined up. Bare in mind
that due to blank spaces being inserted, column A employees are shifting
below row 556.

How can I get the program to carry on lining up the employees below the
original last employee row?

Does this make sense.

Thanks in advance

Malcolm Davidson