Col A

ASMT-NBR 008102510-5
PAYMT COLNBR
1 6068266
REDAMT
ASMT-NBR 008102976-3
PAYMT COLNBR
1 22887
REDAMT 5
ASMT-NBR 010008486-3
PAYMT COLNBR
1 6102130
REDAMT
ASMT-NBR 010008906-6
PAYMT COLNBR
1 415347
2 279003
REDAMT
ASMT-NBR 010009090-1
PAYMT COLNBR
1 6102228
REDAMT
ASMT-NBR 010009201-5
PAYMT COLNBR
1 415347
2 279006

=============

Col B

008102510-5
008102976-3
010008486-3
010008906-6
010009090-1
010009201-5
010009370-4
010009432-7
010009524-7
010009613-4
010009630-9
010013743-1
010013822-9
010015165-5
010015506-0
010016948-9

===================

How can I move the cells in col B down so they're on the same lines as
the matching numbers (after "ASMNT-NBR") in col A? I want the result
to look like this:

Col A Col B

ASMT-NBR 008102510-5 008102510-5
PAYMT COLNBR
1 6068266
REDAMT
ASMT-NBR 008102976-3 008102976-3
PAYMT COLNBR
1 22887
REDAMT 5
ASMT-NBR 010008486-3 010008486-3
PAYMT COLNBR
1 6102130
REDAMT
ASMT-NBR 010008906-6 010008906-6
PAYMT COLNBR
1 415347
2 279003
REDAMT
ASMT-NBR 010009090-1 010009090-1
PAYMT COLNBR
1 6102228
REDAMT
ASMT-NBR 010009201-5 010009201-5
PAYMT COLNBR
1 415347
2 279006

Hi Gary,

Am Thu, 9 Jun 2011 09:08:18 -0700 (PDT) schrieb GARY:

How can I move the cells in col B down so they're on the same lines as
the matching numbers (after "ASMNT-NBR") in col A? I want the result
to look like this:

Col A Col B

ASMT-NBR 008102510-5 008102510-5
PAYMT COLNBR
1 6068266
REDAMT
ASMT-NBR 008102976-3 008102976-3

try:

Sub MoveItems()
Dim i As Long
Dim LRow As Long
Dim rngCell As Range

If Cells(Rows.Count, 2).End(xlUp).Row = _
WorksheetFunction.CountA(Range("B:B")) Then
Columns("B").Insert
i = 1
LRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each rngCell In Range("A1:A" & LRow)
If Left(rngCell, 4) = "ASMT" Then
rngCell.Offset(0, 1) = Cells(i, 3)
i = i + 1
End If
Next
Columns("C").Delete
End If
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Jun 9, 9:35*am, Claus Busch wrote:
Hi Gary,

Am Thu, 9 Jun 2011 09:08:18 -0700 (PDT) schrieb GARY:

How can I move the cells in col B down so they're on the same lines as
the matching numbers (after "ASMNT-NBR") in col A? *I want the result
to look like this:

* * * * * * * * * * Col A * * * * * * * * * * * Col B

ASMT-NBR *008102510-5 * 008102510-5
PAYMT * * * * COLNBR
* 1 * * * * *6068266
REDAMT
ASMT-NBR *008102976-3 * 008102976-3

try:

Sub MoveItems()
Dim i As Long
Dim LRow As Long
Dim rngCell As Range

If Cells(Rows.Count, 2).End(xlUp).Row = _
* * WorksheetFunction.CountA(Range("B:B")) Then
Columns("B").Insert
i = 1
LRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each rngCell In Range("A1:A" & LRow)
* * If Left(rngCell, 4) = "ASMT" Then
* * * * rngCell.Offset(0, 1) = Cells(i, 3)
* * * * i = i + 1
* * End If
Next
Columns("C").Delete
End If
End Sub

Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2



Wow! That worked!!!

But I have an expansion.

For each cell in col B, there is related data in col C thru col I.

How can I move the cells in col B (plus their related data in col C
thru col I) down so they're on the same lines as the matching numbers
(after "ASMNT-NBR") in col A?

Hi Gary,

Am Fri, 10 Jun 2011 06:06:23 -0700 (PDT) schrieb GARY:

How can I move the cells in col B (plus their related data in col C
thru col I) down so they're on the same lines as the matching numbers
(after "ASMNT-NBR") in col A?

try this in a copy of your workbook:
Sub MoveItems()
Dim i As Long
Dim j As Long
Dim LRow As Long
Dim rngCell As Range

If Cells(Rows.Count, 2).End(xlUp).Row = _
WorksheetFunction.CountA(Range("B:B")) Then
j = 2
LRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LRow
If Left(Cells(i, 1), 4) = "ASMT" Then
Range("B" & j & ":I" & LRow).Cut _
Destination:=Cells(i, 2)
j = i + 1
End If
Next
End If
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Jun 10, 6:46*am, Claus Busch wrote:
Hi Gary,

Am Fri, 10 Jun 2011 06:06:23 -0700 (PDT) schrieb GARY:

How can I move the cells in col B (plus their related data in col C
thru col I) down so they're on the same lines as the matching numbers
(after "ASMNT-NBR") in col A?

try this in a copy of your workbook:
Sub MoveItems()
Dim i As Long
Dim j As Long
Dim LRow As Long
Dim rngCell As Range

If Cells(Rows.Count, 2).End(xlUp).Row = _
* * WorksheetFunction.CountA(Range("B:B")) Then
j = 2
LRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LRow
* * If Left(Cells(i, 1), 4) = "ASMT" Then
* * * * Range("B" & j & ":I" & LRow).Cut _
* * * * * * Destination:=Cells(i, 2)
* * * * * * j = i + 1
* * End If
Next
End If
End Sub

Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Thank you, thank you, thank you!!!!!