List issue move all entries to the top

T

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

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
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
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A​
[/th][th]
B​
[/th][th]
C​
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2​
[/td][td=bgcolor:#E2EFDA]AA[/td][td=bgcolor:#FFFFFF]B2[/td][td=bgcolor:#FFFFFF]C2[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3​
[/td][td=bgcolor:#E2EFDA]BB[/td][td=bgcolor:#FFFFFF]B3[/td][td=bgcolor:#FFFFFF]C3[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4​
[/td][td=bgcolor:#E2EFDA]CC[/td][td=bgcolor:#FFFFFF]B4[/td][td=bgcolor:#FFFFFF]C4[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
5​
[/td][td=bgcolor:#E2EFDA]EE[/td][td=bgcolor:#FFFFFF]B5[/td][td=bgcolor:#FFFFFF]C5[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
6​
[/td][td=bgcolor:#E2EFDA]FF[/td][td=bgcolor:#FFFFFF]B6[/td][td=bgcolor:#FFFFFF]C6[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
7​
[/td][td=bgcolor:#E2EFDA]GG[/td][td=bgcolor:#FFFFFF]B7[/td][td=bgcolor:#FFFFFF]C7[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
8​
[/td][td=bgcolor:#E2EFDA]HH[/td][td=bgcolor:#FFFFFF]B8[/td][td=bgcolor:#FFFFFF]C8[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
9​
[/td][td=bgcolor:#FFFFFF]II[/td][td=bgcolor:#FFFFFF]B9[/td][td=bgcolor:#FFFFFF]C9[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
10​
[/td][td=bgcolor:#FFFFFF]JJ[/td][td=bgcolor:#FFFFFF]B10[/td][td=bgcolor:#FFFFFF]C10[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
11​
[/td][td=bgcolor:#FFFFFF]KK[/td][td=bgcolor:#FFFFFF]B11[/td][td=bgcolor:#FFFFFF]C11[/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: Sheet1[/td][/tr][/table]

Clear a few values in A2 to A8

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A​
[/th][th]
B​
[/th][th]
C​
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2​
[/td][td=bgcolor:#E2EFDA]AA[/td][td=bgcolor:#FFFFFF]B2[/td][td=bgcolor:#FFFFFF]C2[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3​
[/td][td=bgcolor:#E2EFDA][/td][td=bgcolor:#FFFFFF]B3[/td][td=bgcolor:#FFFFFF]C3[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4​
[/td][td=bgcolor:#E2EFDA][/td][td=bgcolor:#FFFFFF]B4[/td][td=bgcolor:#FFFFFF]C4[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
5​
[/td][td=bgcolor:#E2EFDA]EE[/td][td=bgcolor:#FFFFFF]B5[/td][td=bgcolor:#FFFFFF]C5[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
6​
[/td][td=bgcolor:#E2EFDA][/td][td=bgcolor:#FFFFFF]B6[/td][td=bgcolor:#FFFFFF]C6[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
7​
[/td][td=bgcolor:#E2EFDA]GG[/td][td=bgcolor:#FFFFFF]B7[/td][td=bgcolor:#FFFFFF]C7[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
8​
[/td][td=bgcolor:#E2EFDA][/td][td=bgcolor:#FFFFFF]B8[/td][td=bgcolor:#FFFFFF]C8[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
9​
[/td][td=bgcolor:#FFFFFF]II[/td][td=bgcolor:#FFFFFF]B9[/td][td=bgcolor:#FFFFFF]C9[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
10​
[/td][td=bgcolor:#FFFFFF]JJ[/td][td=bgcolor:#FFFFFF]B10[/td][td=bgcolor:#FFFFFF]C10[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
11​
[/td][td=bgcolor:#FFFFFF]KK[/td][td=bgcolor:#FFFFFF]B11[/td][td=bgcolor:#FFFFFF]C11[/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: Sheet1[/td][/tr][/table]



After re-activating the sheet

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A​
[/th][th]
B​
[/th][th]
C​
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2​
[/td][td=bgcolor:#E2EFDA]AA[/td][td=bgcolor:#FFFFFF]B2[/td][td=bgcolor:#FFFFFF]C2[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3​
[/td][td=bgcolor:#E2EFDA]EE[/td][td=bgcolor:#FFFFFF]B3[/td][td=bgcolor:#FFFFFF]C3[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4​
[/td][td=bgcolor:#E2EFDA]GG[/td][td=bgcolor:#FFFFFF]B4[/td][td=bgcolor:#FFFFFF]C4[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
5​
[/td][td=bgcolor:#E2EFDA][/td][td=bgcolor:#FFFFFF]B5[/td][td=bgcolor:#FFFFFF]C5[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
6​
[/td][td=bgcolor:#E2EFDA][/td][td=bgcolor:#FFFFFF]B6[/td][td=bgcolor:#FFFFFF]C6[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
7​
[/td][td=bgcolor:#E2EFDA][/td][td=bgcolor:#FFFFFF]B7[/td][td=bgcolor:#FFFFFF]C7[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
8​
[/td][td=bgcolor:#E2EFDA][/td][td=bgcolor:#FFFFFF]B8[/td][td=bgcolor:#FFFFFF]C8[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
9​
[/td][td=bgcolor:#FFFFFF]II[/td][td=bgcolor:#FFFFFF]B9[/td][td=bgcolor:#FFFFFF]C9[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
10​
[/td][td=bgcolor:#FFFFFF]JJ[/td][td=bgcolor:#FFFFFF]B10[/td][td=bgcolor:#FFFFFF]C10[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
11​
[/td][td=bgcolor:#FFFFFF]KK[/td][td=bgcolor:#FFFFFF]B11[/td][td=bgcolor:#FFFFFF]C11[/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: Sheet1[/td][/tr][/table]

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


[TABLE="width: 192"]
<tbody>[TR]
[/TR]
[TR]
[TD="class: xl63"][/TD]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[/TR]
[TR]
[TD="class: xl63"][/TD]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[/TR]
[TR]
[TD="class: xl63"][/TD]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[/TR]
[TR]
[TD="class: xl63"][/TD]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[/TR]
[TR]
[TD="class: xl63"][/TD]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[/TR]
[TR]
[TD="class: xl63"][/TD]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[/TR]
[TR]
[TD="class: xl63"][/TD]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[/TR]
[TR]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[/TR]
[TR]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[/TR]
[TR]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[/TR]
</tbody>[/TABLE]
 
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
You must log in or register to reply here.

Similar threads

E
  • Solved
Can you add NULL (not Blank "") to an If statement in a formula?
2
Replies
15
Views
1K
MARK858
MARK858
D
  • Question Question
Copy the value of a cell onto another worksheet based on the dropdown selection
Replies
4
Views
522
mumps
mumps
F
  • Solved
Sort data without changing the set of each data (using VBA)
2
Replies
12
Views
417
feni1388
F
C
  • Question Question
Macro that changes cell after each copy and paste
2
Replies
11
Views
1K
PeteWright
PeteWright
GMC The Macro Man
  • Solved
Searchable Drop down List
Replies
4
Views
377
KevCarter
KevCarter

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

Share this page

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