Separating names and numbers that are in the same column into separate columns

[jdk8008]

Hello there,

I have a problem that hopefully someone can help me with. I need names and invoice numbers in column A to be placed in separate columns (B & C).
If you refer to my example below, column A is the data I have now, and columns B & C are what I need it to be.

• The name needs to be in the same row as the number indicating that this number belongs to this person.
• The names need to be listed next to each number.
• There is a blank cell below each person in my current data. I need these blank cells to remain present in B & C after the data is separated. The result should be two blank cells in between each name after the first person.

A	B	C
Doe, John
1111	Doe, John	1111
2222	Doe, John	2222
Smith, Ron
3333	Smith, Ron	3333
Jones, Brad
4444	Jones, Brad	4444
5555	Jones, Brad	5555
6666	Jones, Brad	6666

<tbody>
</tbody>

Any help someone can give in VBA form would be great. I have tried, but my knowledge of the syntax is very limited. Thanks!

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

Try this:

Sub Rearrange()

    Dim ws As Worksheet
    Dim Name As String
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    With ws
        For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If .Cells(i, "A").Value = "" Then
                    ' do nothing
            ElseIf IsNumeric(.Cells(i, "A").Value) Then
                .Cells(i, "B").Value = Name
                .Cells(i, "C").Value = .Cells(i, "A").Value
            Else
                Name = .Cells(i, "A").Value
            End If
        Next
    End With
    
End Sub

I have assumed a sheet name of Sheet1 but you can overtype that to change it.
Working out the last row in column A using:

.Cells(.Rows.Count, "A").End(xlUp).Row

is worth remembering. You need to do that very often.
If the cell in column A is blank the macro does nothing;
If it contains a number then it outputs the number and name;
Otherwise it must be a name so it remembers it for the next time.

Perversely, the macro needs to check for things in reverse order. That is, the thing expected last (a blank) needs to be tested for first and the thing it expects first (a name) it checks for last. This applies to all procedural languages.

 

[Rick Rothstein]

Give this macro a try...

Sub NameAndNumbers()
  Dim Ar As Range
  For Each Ar In Columns("A").SpecialCells(xlConstants).Areas
    Ar(1).Offset(1, 1).Resize(Ar.Rows.Count - 1) = Ar(1)
    Ar(1).Offset(1).Resize(Ar.Rows.Count - 1).Copy Ar(1).Offset(1, 2)
  Next
End Sub

 

[RickXL]

Rick,

That is pretty neat Mr Rothstein!

 

[jdk8008]

This worked beautifully. It definitely helps me understand the syntax as well with the explanation. Thanks!

Hi and welcome to the MrExcel Message Board.

Try this:

Sub Rearrange()

    Dim ws As Worksheet
    Dim Name As String
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    With ws
        For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If .Cells(i, "A").Value = "" Then
                    ' do nothing
            ElseIf IsNumeric(.Cells(i, "A").Value) Then
                .Cells(i, "B").Value = Name
                .Cells(i, "C").Value = .Cells(i, "A").Value
            Else
                Name = .Cells(i, "A").Value
            End If
        Next
    End With
    
End Sub

I have assumed a sheet name of Sheet1 but you can overtype that to change it.
Working out the last row in column A using:

.Cells(.Rows.Count, "A").End(xlUp).Row

is worth remembering. You need to do that very often.
If the cell in column A is blank the macro does nothing;
If it contains a number then it outputs the number and name;
Otherwise it must be a name so it remembers it for the next time.

Perversely, the macro needs to check for things in reverse order. That is, the thing expected last (a blank) needs to be tested for first and the thing it expects first (a name) it checks for last. This applies to all procedural languages.

 

[RickXL]

No problem.

Thanks for letting me know.

Regards,