Remove blank cells in a given range (remove gaps between cells)

[thedeadzeds]

Guys, is there a way to via vba move all of the names so there are no gaps so example 1 looks like example 2. The data is currerntly in range c22 to E40 in sheet called 'Allocate'

EXAMPLE 1
[TABLE="class: grid, width: 456"]
<colgroup><col span="2"><col></colgroup><tbody>[TR]
[TD]Name1[/TD]
[TD]Name2[/TD]
[TD]Name3[/TD]
[/TR]
[TR]
[TD]Angela Rose[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Bethan Mason[/TD]
[TD] [/TD]
[TD]Angela Rose[/TD]
[/TR]
[TR]
[TD]Chloe Whitfield[/TD]
[TD]Bethan Mason[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]Angela Rose[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]Chloe Whitfield[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]Angela Rose[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Lorna Young[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]Bethan Mason[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Nicole Foxwell[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]

EXAMPLE 2
[TABLE="class: grid, width: 456"]
<colgroup><col span="2"><col></colgroup><tbody>[TR]
[TD]Name1[/TD]
[TD]Name2[/TD]
[TD]Name3[/TD]
[/TR]
[TR]
[TD]Angela Rose[/TD]
[TD]Bethan Mason[/TD]
[TD]Angela Rose[/TD]
[/TR]
[TR]
[TD]Bethan Mason[/TD]
[TD]Chloe Whitfield[/TD]
[TD]Angela Rose[/TD]
[/TR]
[TR]
[TD]Chloe Whitfield[/TD]
[TD]Bethan Mason[/TD]
[TD]Angela Rose[/TD]
[/TR]
[TR]
[TD]Lorna Young[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nicole Foxwell[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Try:-

[COLOR="Navy"]Sub[/COLOR] MG16Nov56
[COLOR="Navy"]Dim[/COLOR] rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] rng = Range("A:c").SpecialCells(xlCellTypeBlanks)
rng.Delete shift:=xlUp
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Fluff]

try

Sub removeblanks()
Range("C22:E40").SpecialCells(xlBlanks).Delete xlShiftUp
End Sub

 

[MickG]

You can also:- Select area.
Then "Home" > "Find & Select" > "Go to special" > "Blank"> "Ok.
Right click Area, "Select Delete" > "shift Cells Up" > "OK"