List issue move all entries to the top

test3xc31

New Member
Joined
Jun 11, 2019
Messages
27
Office Version
  1. 2021
Platform
  1. Windows
I'm not sure where to start with this one in VBA to be honest, If possible I would like to avoid an formula array list and VBA copy/paste which is how I would normaly do it but I'm finding my workbook is getting a bit slow!

If I have range A2:A8

Cell A2 entry AA
Cell A3 entry BB
Cell A4 entry CC
Cell A5 Entry DD
Cell A6 entry EE
Cell A7 entry FF
Cell A8 entry GG

if data from any cell is deleted, for instance A4 and A6,

Cell A2 entry AA
Cell A3 entry BB
Cell A4 entry Blank
Cell A5 Entry DD
Cell A6 entry Blank
Cell A7 entry FF
Cell A8 entry GG


Is there a way to get the data from A5 though A8 to move/shift up upon sheet activation so that all blanks are at the bottom of the list but without affecting any cells outside of the range ie

Cell A2 entry AA
Cell A3 entry BB
Cell A4 entry DD
Cell A5 Entry FF
Cell A6 entry GG
Cell A7 entry Blank
Cell A8 entry Blank

Thankyou in advance, even a pointer of where to start would be appreacted.
 
Last edited:

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
This should do (untested) what you want for every row in column A

Code:
Private Sub Worksheet_Activate()' put inside worksheet code


Application.ScreenUpdating = False
Dim L As Long, X As Long, T As Long, G As Long


L = Range("A" & ActiveSheet.UsedRange.Rows.Count).End(xlDown).Row
For X = 1 To L


    If ActiveSheet.Range("A" & X).value2 = "" Then
        
        T = X
        
        For G = T To L
            
          ActiveSheet.Range("A" & G).value2 = ActiveSheet.Range("A" & G + 1).value2
          
        
        Next G
         Active Sheet.range("A"& L).clearcontents
        L = L - 1
        
    End If


Next X
      
Application.ScreenUpdating = False


End Sub
 
Last edited:
Upvote 0
MoshiM

Should that be:
Code:
Application.ScreenUpdating = True
...at the end, rather than:
Code:
Application.ScreenUpdating = False
 
Upvote 0
I came up with this:
Code:
Sub del_cells()
Dim rng As Range
Dim cl As Range
Dim rws As String
Dim cntr As Integer

Set rng = .Range("A2:A8")

With Me
    cntr = 0
    For Each cl In rng
        If cl.Value = "" Then rws = rws & "A" & cl.Row & ",": cntr = cntr + 1
    Next
        If rws = "" Then Exit Sub
    rws = Left(rws, Len(rws) - 1)
    
    .Range(rws).Delete (xlShiftUp)
    .Range("A" & 9 - cntr & ":A8").Insert (xlShiftDown)
End With
End Sub
It'll need to go into the worksheet's module, due to my use of the "Me" keyword.
 
Upvote 0
Another option
Code:
Private Sub Worksheet_Activate()
   Range("A:A").SpecialCells(xlBlanks).Delete xlUp
End Sub


@MoshiM
Your code is going to loop through every single row in the sheet (ie all 1,048,576) multiple times.
 
Last edited:
Upvote 0
Sorry - didn't read the requirement to have the code run upon sheet activation; the code will need to go into the sheet's "_Activate" module...
Code:
Private Sub Worksheet_Activate()
Dim rng As Range
Dim cl As Range
Dim rws As String
Dim cntr As Integer

Set rng = .Range("A2:A8")

With Me
    cntr = 0
    For Each cl In rng
        If cl.Value = "" Then rws = rws & "A" & cl.Row & ",": cntr = cntr + 1
    Next
        If rws = "" Then Exit Sub
    rws = Left(rws, Len(rws) - 1)
    
    .Range(rws).Delete (xlShiftUp)
    .Range("A" & 9 - cntr & ":A8").Insert (xlShiftDown)
End With
End Sub
 
Upvote 0
Here is another option

Before


Excel 2016 (Windows) 32 bit
A
B
C
1
2
AAB2C2
3
BBB3C3
4
CCB4C4
5
EEB5C5
6
FFB6C6
7
GGB7C7
8
HHB8C8
9
IIB9C9
10
JJB10C10
11
KKB11C11
Sheet: Sheet1

Clear a few values in A2 to A8

Excel 2016 (Windows) 32 bit
A
B
C
1
2
AAB2C2
3
B3C3
4
B4C4
5
EEB5C5
6
B6C6
7
GGB7C7
8
B8C8
9
IIB9C9
10
JJB10C10
11
KKB11C11
Sheet: Sheet1



After re-activating the sheet

Excel 2016 (Windows) 32 bit
A
B
C
1
2
AAB2C2
3
EEB3C3
4
GGB4C4
5
B5C5
6
B6C6
7
B7C7
8
B8C8
9
IIB9C9
10
JJB10C10
11
KKB11C11
Sheet: Sheet1

Code:
Private Sub Worksheet_Activate()
    Const F = 2, L = 8
    Dim r As Long
    Application.ScreenUpdating = False
    For r = L To F Step -1
        If IsEmpty(Cells(r, 1).Value) Then
            Cells(L + 1, 1).Insert Shift:=xlDown
            Cells(F, 1).Copy
            Cells(L + 1, 1).PasteSpecial (xlPasteFormats)
            Cells(r, 1).Delete Shift:=xlUp
        End If
    Next r
End Sub



<tbody>
</tbody>
 
Upvote 0
Sorry (again!) I needed to move the "With" statement one line further up:
Code:
Private Sub Worksheet_Activate()
Dim rng As Range
Dim cl As Range
Dim rws As String
Dim cntr As Integer

With Me
    Set rng = .Range("A2:A8")
    cntr = 0
    For Each cl In rng
        If cl.Value = "" Then rws = rws & "A" & cl.Row & ",": cntr = cntr + 1
    Next
        If rws = "" Then Exit Sub
    rws = Left(rws, Len(rws) - 1)
    
    .Range(rws).Delete (xlShiftUp)
    .Range("A" & 9 - cntr & ":A8").Insert (xlShiftDown)
End With
End Sub
... place code in the worksheet's module.
 
Upvote 0
Wow I go out for the day and you guys seriously come up with the goods! I'll test and let you know. Thanks you!
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top