Excel Macro - Loop to copy column of cells into row which repeats afte

[jupops]

Good Afternoon

Could anybody please help. I am trying to write a macro that will concatenate cells or move the row up to the next column of a cell which starts with a number, Then stops when the two rows are empty but ignores if it is only one empty row.

But then moves down the row until the cell starts with a character and repeats the procedure until it the end of the report.


I have a similar macro which will move data up when it is one empty row (see below):

-------------------------------------------------
Sub test()
Dim r As Range, lRow As Long, iCol As Integer, wsIN As Worksheet, wsOUT As Worksheet

Set wsIN = ActiveSheet
Set wsOUT = Worksheets.Add(after:=Sheets(Sheets.Count))

lRow = 2
iCol = 1
With wsIN
For Each r In Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
If Trim(r.Value) = "" Then
lRow = wsOUT.[A1].CurrentRegion.Rows.Count + 1
iCol = 1
Else
wsOUT.Cells(lRow, iCol).Value = r.Value
iCol = iCol + 1
End If
Next
End With

Set wsIN = Nothing
Set wsOUT = Nothing
End Sub

-----------------------------------------------------------


For Example,, All the below are in column A and starts from Row 1

7300002 ALIT 1109 041109
BRANDED LEIS iINFO
THIS ITEM IS SUBJECT
INSPECTION BY JOE

7300003 ALIM 311211
ALL OK


7300003 FRED 2511011211
OPEN WHEN READYY
ABCD NOT CHECKED
SUBJECT TO FFRES
DEK GO TO BAR
INSPECTION BY JAMES



So I tried to copy A1 (7300002 ALIT 1109 041109) into A1 on a new sheet, then because next cell below was not empty (A2 - BRANDED LEIS iINFO) copied into B1 on the new sheet, Then it would move down to the next cell (A3 - THIS ITEM IS SUBJECT) and this would go into C1 on new sheet and repeat so A4 (INSPECTION BY JOE) will be copied to D1 on new sheet. Now because the next row is blank and the next has data it copies to E1, then (7300003 ALIM 311211) will be copied to F! and (ALL OK ) will be copied to G. Now because I have two blank rows next yo eacdh other it ends the loop and Finds the next populated cell from the first sheet anpeats the operation, but copying to row 2 on new sheet so A10 (7300003 FRED 2511011211) copied to A2, A11 (OPEN WHEN READYY) Coped to B2 and A12(ABCD NOT CHECKED) copied to C2. Again with the blank row ends loop.

This is repeated until end of document,

Alternately is there a macro to delete a empty row in two rows are consecutively empty to leave just the empty row.

I would be grateful for any guidance. Thank You

Regards

Jupops

 

[PHV]

What about this ?

Sub test()
Dim r As Range, lRow As Long, iCol As Integer, wsIN As Worksheet, wsOUT As Worksheet
Dim iBlank As Integer
Set wsIN = ActiveSheet
Set wsOUT = Worksheets.Add(after:=Sheets(Sheets.Count))
iBlank = 0
lRow = 1
iCol = 1
With wsIN
  For Each r In Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    If Trim(r.Value) = "" Then
      iBlank = iBlank + 1
      If iBlank = 2 Then
        lRow = lRow + 1
        iCol = 1
        iBlank = 0
      Else
        iCol = iCol + 1
      End If
    Else
      iBlank = 0
      wsOUT.Cells(lRow, iCol).Value = r.Value
      iCol = iCol + 1
    End If
  Next
End With
Set wsIN = Nothing
Set wsOUT = Nothing
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886