MOVE CELLS DOWN

[gary c]

How can I move the cells in COL A down so their RIGHT 7 characters are
on the same row as the matching LEFT 7 characters in COL B?

A
000041813-5 1991 01/04/2002 000000000005546 0100966
000078740-6 1991 01/04/2002 000000000005547 0101044
000088731-9 1991 01/04/2002 000000000005548 0101333
000088732-0 1991 01/04/2002 000000000005549 0101334
000086314-0 1990 02/11/2002 000000000074959 0104353
000092895-7 1991 02/11/2002 000000000074960 0104354
001137125-0 1991 01/04/2002 000000000005550 0104409
001137126-1 1991 01/04/2002 000000000005551 0104410
001137216-9 1991 01/04/2002 000000000005552 0104415
001137222-4 1991 01/04/2002 000000000005553 0104416
001137312-2 1991 01/04/2002 000000000005554 0104424
001137404-2 1991 01/04/2002 000000000005555 0104434
001137491-0 1991 01/04/2002 000000000005556 0104438
001137500-5 1991 01/04/2002 000000000005557 0104439
001137501-6 1991 01/04/2002 000000000005558 0104440
001137769-2 1991 01/04/2002 000000000005559 0104443
001137800-6 1991 01/04/2002 000000000005560 0104445
001137801-7 1991 01/04/2002 000000000005561 0104446
001137844-6 1991 01/04/2002 000000000005562 0104458


B
0100944 000015765-4 1991 000000000356756
0100951 000028429-1 2001 000000000499532
0100951 000028429-1 1991 000000000356761
0100957 000037846-2 2001 000000000499533
0100957 000037846-2 1991 000000000356767
0100966 000041813-5 2002 000000000005546
0100966 000041813-5 1992 000000000015333
0100971 000044651-4 2001 000000000499534
0101042 000078468-1 1991 000000000356815
0101044 000078740-6 2002 000000000005547
0101044 000078740-6 1992 000000000016001
0101070 000085632-4 2001 000000000499546
0101328 000087003-2 2001 000000000494814
0101328 000087003-2 1991 000000000364202
0101333 000088731-9 2002 000000000005548
0101333 000088731-9 1992 000000000017287
0101334 000088732-0 2002 000000000005549
0101334 000088732-0 1992 000000000017286
0101338 000090601-2 1991 000000000364206
0101342 000090714-1 2001 000000000499710
0101342 000090714-1 1991 000000000364210
0104353 000086314-0 2002 000000000074959
0104353 000086314-0 1992 036903
0104354 000092895-7 2002 000000000074960
0104354 000092895-7 1992 036904
0104361 000089983-3 1992 036832
0104365 000079441-9 1992 135375
0104367 000012505-7 1992 163303
0104368 000083925-3 1992 163304
0104370 000064539-9 1992 163305
0104409 001137125-0 2002 000000000005550
0104409 001137125-0 1992 000000000020932
0104410 001137126-1 2002 000000000005551
0104410 001137126-1 1992 000000000020933
0104415 001137216-9 2002 000000000005552
0104415 001137216-9 1992 000000000020937
0104416 001137222-4 2002 000000000005553
0104416 001137222-4 1992 000000000020938
0104424 001137312-2 2002 000000000005554
0104424 001137312-2 1992 000000000020944
0104434 001137404-2 2002 000000000005555
0104434 001137404-2 1992 000000000020954
0104438 001137491-0 2002 000000000005556
0104438 001137491-0 1992 000000000020958
0104439 001137500-5 2002 000000000005557
0104439 001137500-5 1992 000000000020959
0104440 001137501-6 2002 000000000005558
0104440 001137501-6 1992 000000000020960
0104443 001137769-2 2002 000000000005559
0104443 001137769-2 1992 000000000020963
0104445 001137800-6 2002 000000000005560
0104445 001137800-6 1992 000000000020965
0104446 001137801-7 2002 000000000005561
0104446 001137801-7 1992 000000000020966
0104458 001137844-6 2002 000000000005562
0104458 001137844-6 1992 000000000020970
0104479 001137397-9 2002 000000000074962
0104479 001137397-9 1992 000000000038676

 

[Auric__]

How can I move the cells in COL A down so their RIGHT 7 characters are
on the same row as the matching LEFT 7 characters in COL B?

This works with the specific data you posted:

Sub lineup()
Dim check As String, against As String
Dim r1 As Long, r2 As Long
r1 = 1
stoprow = Cells.SpecialCells(xlCellTypeLastCell).Row
looper:
check = Right$(Cells(r1, 1).Value, 7)
Application.StatusBar = "row " & r1
For r2 = r1 To Cells.SpecialCells(xlCellTypeLastCell).Row
against = Left$(Cells(r2, 2).Value, 7)
If (r2 > stoprow) Then GoTo done
If (check) = against Then Exit For
Cells(r2, 1).Insert Shift:=xlDown
Cells(r2 + 1, 1).Select
DoEvents
Next
r1 = r2 + 1
GoTo looper
done:
Application.StatusBar = Null
End Sub

Test with test data BEFORE using live. (Make a copy of your data and test on
*that*.)

 

[gary c]

This works with the specific data you posted:

    Sub lineup()
        Dim check As String, against As String
        Dim r1 As Long, r2 As Long
        r1 = 1
        stoprow = Cells.SpecialCells(xlCellTypeLastCell).Row
    looper:
        check = Right$(Cells(r1, 1).Value, 7)
        Application.StatusBar = "row " & r1
        For r2 = r1 To Cells.SpecialCells(xlCellTypeLastCell).Row
            against = Left$(Cells(r2, 2).Value, 7)
            If (r2 > stoprow) Then GoTo done
            If (check) = against Then Exit For
            Cells(r2, 1).Insert Shift:=xlDown
            Cells(r2 + 1, 1).Select
            DoEvents
        Next
        r1 = r2 + 1
        GoTo looper
    done:
        Application.StatusBar = Null
    End Sub

Test with test data BEFORE using live. (Make a copy of your data and teston
*that*.)

Thank You!

You saved me many, many hours of manually moving over 4,000 cells in
COL A down next to their matching cells in 17,000 cells in COL B.

 

[Auric__]

Thank You!

You saved me many, many hours of manually moving over 4,000 cells in
COL A down next to their matching cells in 17,000 cells in COL B.

Np. You're welcome.

 

[gary c]

This works with the specific data you posted:

    Sub lineup()
        Dim check As String, against As String
        Dim r1 As Long, r2 As Long
        r1 = 1
        stoprow = Cells.SpecialCells(xlCellTypeLastCell).Row
    looper:
        check = Right$(Cells(r1, 1).Value, 7)
        Application.StatusBar = "row " & r1
        For r2 = r1 To Cells.SpecialCells(xlCellTypeLastCell).Row
            against = Left$(Cells(r2, 2).Value, 7)
            If (r2 > stoprow) Then GoTo done
            If (check) = against Then Exit For
            Cells(r2, 1).Insert Shift:=xlDown
            Cells(r2 + 1, 1).Select
            DoEvents
        Next
        r1 = r2 + 1
        GoTo looper
    done:
        Application.StatusBar = Null
    End Sub

Test with test data BEFORE using live. (Make a copy of your data and teston
*that*.)

What happens if a match is not found? (Is there an error-message, a
blank line or ????),

 

[Auric__]

[snip code]

What happens if a match is not found? (Is there an error-message, a
blank line or ????),

You mean no matches at all? Then all the data in A gets moved below the
data in B. So if there are, say, 5 items in B2:B6, then A2:A6 is empty and
the data in A starts on A7, like this:
A B
2 data
3 data
4 data
5 data
6 data
7 data
8 data
9 data
10 data
11 data

If you *want* some sort of indicator, you just add a flag (the new variable
"found" here):
Sub lineup()
Dim found As Boolean
Dim check As String, against As String
Dim r1 As Long, r2 As Long
r1 = 1
stoprow = Cells.SpecialCells(xlCellTypeLastCell).Row
looper:
check = Right$(Cells(r1, 1).Value, 7)
Application.StatusBar = "row " & r1
For r2 = r1 To Cells.SpecialCells(xlCellTypeLastCell).Row
against = Left$(Cells(r2, 2).Value, 7)
If (r2 > stoprow) Then GoTo done
If (check) = against Then found = True: Exit For
Cells(r2, 1).Insert Shift:=xlDown
Cells(r2 + 1, 1).Select
DoEvents
Next
r1 = r2 + 1
GoTo looper
done:
If Not found Then MsgBox "No matches found!"
Application.StatusBar = Null
End Sub

This still does as I mentioned above, moving all of A below B's data. (To
avoid that, you'd need to separate the scanning and the inserting.)