Move cells down

[GARY]

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

 

[Claus Busch]

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

 

[GARY]

Hi Gary,

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




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

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?

 

[Claus Busch]

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

 

[GARY]

Hi Gary,

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


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

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