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
 

Some videos you may like

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.

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,884
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
 

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,884
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
 

joespapi

New Member
Joined
Feb 25, 2015
Messages
2
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)
 

Watch MrExcel Video

Forum statistics

Threads
1,122,828
Messages
5,598,335
Members
414,231
Latest member
Mig

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
Top