ExcelBanter - Move cells up

ExcelBanter (https://www.excelbanter.com/)

- Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)

- - Move cells up (https://www.excelbanter.com/excel-discussion-misc-queries/447636-move-cells-up.html)

How can I move the cells beginning with "0000000", "028", and "0PAID STATUS" onto the same row as the preceding cell beginning with "0ASMNT-NBR"? (Note: the number of cells beginning with "028" varies).

0ASMNT-NBR 050607227-9
0000000
0PAID STATUS
0ASMNT-NBR 050607489-9
0000000
0PAID STATUS
0ASMNT-NBR 050607522-5
0000000
0PAID STATUS
0ASMNT-NBR 050607657-4
0000000
0PAID STATUS
0ASMNT-NBR 050607749-4
0000000
0PAID STATUS
0ASMNT-NBR 050607801-7
0000000
0PAID STATUS
0ASMNT-NBR 050607842-4
0000000
02844831
0PAID STATUS
0ASMNT-NBR 050608520-6
0000000
0285275
0PAID STATUS
0ASMNT-NBR 050608546-0
0000000
0PAID STATUS
0ASMNT-NBR 050608547-1
0000000
0PAID STATUS
0ASMNT-NBR 050608548-2
0000000
0PAID STATUS
0ASMNT-NBR 050608555-8
0000000
0PAID STATUS
0ASMNT-NBR 050608605-0
0000000
0PAID STATUS
0ASMNT-NBR 050608618-2
0000000
0PAID STATUS
0ASMNT-NBR 050608706-8
0000000
02844831
0PAID STATUS
0ASMNT-NBR 050608739-8
0000000
02844831
0PAID STATUS
0ASMNT-NBR 050608750-7
0000000
02844831
0PAID STATUS
0ASMNT-NBR 050608757-4
0000000
02844831
0PAID STATUS
0ASMNT-NBR 050608762-8
0000000
02844831
0PAID STATUS
0ASMNT-NBR 050609462-0
0000000
0285291
0PAID STATUS
0ASMNT-NBR 050609482-8
0000000
0PAID STATUS
0ASMNT-NBR 050609658-1
0000000
0PAID STATUS
0ASMNT-NBR 050609754-4
0000000
0PAID STATUS
0ASMNT-NBR 050610381-4
0000000
0PAID STATUS
0ASMNT-NBR 050610456-9
0000000
0PAID STATUS

Hi,

Am Mon, 12 Nov 2012 12:09:07 -0800 (PST) schrieb gwc:

How can I move the cells beginning with "0000000", "028", and "0PAID STATUS" onto the same row as the preceding cell beginning with "0ASMNT-NBR"? (Note: the number of cells beginning with "028" varies).

try:

Sub Transpose()
Dim rngC As Range
Dim Start As Long
Dim i As Integer
Dim LRow As Long

Application.ScreenUpdating = False
LRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each rngC In Range("A1:A" & LRow)
If InStr(rngC, "0ASM") = 1 Then
Start = rngC.Row
i = 1
End If
If InStr(rngC, "0ASM") = 0 Then
i = i + 1
Cells(Start, i) = rngC
End If
Next
For i = LRow To 2 Step -1
If Cells(i, 2) = "" Then
Cells(i, 2).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub

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