Move cells to the next columnClosed

Question

Hello,

I have a report that comes already formated for printing.  However, I want to be able to manipulate the data to analyze it.  Currently the report has a colums with employee's name and the division they belong to right below their name.  I want to create a colum adjecent to their name called division and move their assigned division over.  I could do it with a drag and drop but we are talking about several hundred employees.  And to complicate things, there are empty cells between one employee and the next, for example:

Name

Joe Smith
yellow team


Mary Sue
blue team

Carol Who
red team

I would like to delete the spaces (empty cells) and move their team name to the next colum over.  Can I run a Macro for that?

Helper · Answer

Assumption:
The employee names are in Column A


Private Sub CommandButton1_Click()

Dim i
Dim dup
Dim r
r = Range("A65536").End(xlUp).Row 'This will find the last used row regardless of empty cells
i = 1

Columns("B:B").Select  'You stated creating a column so I assume you want to insert column for the team name
Selection.Insert Shift:=xlToRight

'This will first move the team names beside the person's name and delete the team name.
For i = i To r

    If Not IsEmpty(Range("A" & i)) And Right(Range("A" & i), 4) = "team" Then 
    dup = i
    
    Range("B" & i).Offset(-1, 0) = Range("A" & dup)
    Rows(dup).EntireRow.Delete Shift:=xlUp
    
    End If

Next i

i = 1
'Now we can delete the empty rows
Rows(r).Select
For r = r To i Step -1

    If Range("A" & r) = "" Then
        Rows(r).EntireRow.Delete
    End If
    
Next r

Range("A1").Select

End Sub

Move cells to the next column

1 response

Similar discussions

Subscribe To Our Newsletter!