Macro for looping through cells and copying out values based on the value being isnumeric or not

[Ronanm]

Hi

I need to loop through a column and based on whether the value starts with a number, copy this value to the cell to the right of it and append any cells below it which are not numeric and then repeat when you find a cell where the first value is numeric again... to get the results as per below.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]9b34 test
[/TD]
[TD]9b34 test These are just words[/TD]
[/TR]
[TR]
[TD]These are just words
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1uy8 some more bits[/TD]
[TD]1uy8 some more bits Cells and stuff here more text and again[/TD]
[/TR]
[TR]
[TD]Cells and stuff here[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]more text[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]and again[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6h89 cell[/TD]
[TD]6h89 cell there it is[/TD]
[/TR]
[TR]
[TD]there it is[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Many Thanks

 

[Nine Zero]

Here you go try this out

Sub Numbers()
Dim r As Range
For Each r In Range("A1:A10") 'Change this range to where your data is
    If IsNumeric(Left(r.Value, 1)) = True Then
        r.Offset(, 1).Value = r.Value
    End If
Next r
End Sub

EDIT**** Wait i just saw the part about appending the ones below... working on it

 

[Nine Zero]

Alright try this one out

Sub Numbers()
Dim r As Long
Dim line As String
line = ""
For r = 10 To 1 Step -1 'change the number 10 here to the last row of data 
    If IsNumeric(Left(Cells(r, [COLOR=#ff0000]1[/COLOR]).Value, 1)) = False Then
        line = Cells(r, [COLOR=#ff0000]1[/COLOR]).Value & " " & line
    Else
        line = Cells(r,[COLOR=#ff0000] 1[/COLOR]).Value & " " & line
        Cells(r, [COLOR=#0000ff]2[/COLOR]).Value = line
        line = ""
    End If
Next r
End Sub

The red number 1 is the column A and the blue 2 is column B .... change those to whatever columns you need

 

[Ronanm]

Alright try this one out

Sub Numbers()
Dim r As Long
Dim line As String
line = ""
For r = 10 To 1 Step -1 'change the number 10 here to the last row of data 
    If IsNumeric(Left(Cells(r, [COLOR=#ff0000]1[/COLOR]).Value, 1)) = False Then
        line = Cells(r, [COLOR=#ff0000]1[/COLOR]).Value & " " & line
    Else
        line = Cells(r,[COLOR=#ff0000] 1[/COLOR]).Value & " " & line
        Cells(r, [COLOR=#0000ff]2[/COLOR]).Value = line
        line = ""
    End If
Next r
End Sub

The red number 1 is the column A and the blue 2 is column B .... change those to whatever columns you need

This works perfectly. Thank you so much for that. Appreciate it.

 

[Nine Zero]

no problem, glad i could help