VBA for Rotating Names while skipping Empty Cells

joespapi

New Member
Joined
Feb 25, 2015
Messages
2
Hi all. I'm new to the site. Thanks in advance for the help. I am trying to perfect my rotation macro that moves names up a column while taking the top name and placing it at the bottom but i need it to skip the empty cells in the middle of the column. If new names get added they go in the middle of the rotation and not at the end.


My datawhat my macro doeswhat i need it to do
joejimjim
jimbobbob
bobsam
sam
samnicknick
nickstanstan
stanjoejoe

<tbody>
</tbody>





Public Sub RotateLoader()
Dim rngRest As Range
Dim vaTemp As Variant
Dim iNumUsedRows As Long
Dim iDemotedRow As Long
ActiveWorkbook.Sheets("Rotation").Activate​
With Columns("B").Find(what:="*", after:=.Cells(1, 1), LookIn:=xlFormulas).Activate​
End With

iDemotedRow = ActiveCell.Row​
iNumUsedRows = Range("B:B").Rows.Count - _​
Range(Cells(Range("B:B").Rows.Count, ActiveCell.Column), _​
Cells(Range("B:B").Rows.Count, ActiveCell.Column). _​
End(xlUp)).Rows.Count​
vaTemp = Cells(iDemotedRow, ActiveCell.Column).Value​
Set rngRest = Range(Cells(iDemotedRow + 1, ActiveCell.Column), _​
Cells(iNumUsedRows + 1, ActiveCell.Column))​
rngRest.Copy Cells(iDemotedRow, ActiveCell.Column)​
Cells(iNumUsedRows + 1, ActiveCell.Column).Value = vaTemp​


End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Try this:

Code:
Sub RotateTopToBottomSkipBlanks()
    
    Const lTopDataRow As Long = 2
    Dim lLastRow As Long
    Dim lFirstGroupLastRow As Long
    Dim lSecondGroupFirstRow As Long
    Dim lIndex As Long
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    lFirstGroupLastRow = Cells(1, 1).End(xlDown).Row
    lSecondGroupFirstRow = Cells(lLastRow, 1).End(xlUp).Row
    
    Cells(lLastRow + 1, 1).Value = Cells(2, 1).Value
    For lIndex = 2 To lLastRow + 1
        Select Case lIndex
        Case Is < lFirstGroupLastRow
            Cells(lIndex, 1).Value = Cells(lIndex + 1, 1).Value
        Case Is = lFirstGroupLastRow
            Cells(lFirstGroupLastRow, 1).Value = Cells(lSecondGroupFirstRow, 1).Value
        Case Is >= lSecondGroupFirstRow
            Cells(lIndex, 1).Value = Cells(lIndex + 1, 1).Value
        End Select
    Next
    Cells(lLastRow + 1, 1).Value = vbNullString
End Sub
 
Upvote 0
Slightly more compact:
Code:
Option Explicit

Sub RotateTopToBottomSkipBlanks()
    
    Const lTopDataRow As Long = 2
    Dim lLastRow As Long
    Dim lFirstGroupLastRow As Long
    Dim lSecondGroupFirstRow As Long
    Dim lIndex As Long
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    lFirstGroupLastRow = Cells(1, 1).End(xlDown).Row
    lSecondGroupFirstRow = Cells(lLastRow, 1).End(xlUp).Row
    
    Cells(lLastRow + 1, 1).Value = Cells(2, 1).Value
    For lIndex = 2 To lLastRow + 1
        Select Case lIndex
        Case Is < lFirstGroupLastRow, Is >= lSecondGroupFirstRow
            Cells(lIndex, 1).Value = Cells(lIndex + 1, 1).Value
        Case Is = lFirstGroupLastRow
            Cells(lFirstGroupLastRow, 1).Value = Cells(lSecondGroupFirstRow, 1).Value
        End Select
    Next
    Cells(lLastRow + 1, 1).Value = vbNullString
End Sub
 
Upvote 0
That worked great. I appreciate your assistance. I had worked out a way to get it done but my code ended up being extremely loooooong, this is an excellent upgrade.

-JPF

(y)
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

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