Forum Discussion
christopherwhiten
Jul 12, 2024Copper Contributor
Excel VBA move row up once status is marked “DONE” above a merged row and put in numerical order.
I am having problems figuring out how to code the following. Once the column ‘Status’ is marked “DONE” need to move the row up above a merged row and put it in numerical order based off ‘Workorder Nu...
- Jul 12, 2024
Right-click the sheet tab.
Select 'View Code' from the context menu.
Copy the code listed below into the worksheet module,
Switch back to Excel.
Save the workbook as a macro-enabled workbook (*.xlsm).
Make sure that you allow macros when you open it.
Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Dim cel As Range Dim trg As Range Set rng = Intersect(Range("D18:D30"), Target) If Not rng Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False For Each cel In rng If cel.Value = "DONE" Then Set trg = Range("A18").End(xlUp) If trg.Row = 1 Then MsgBox "No more room!", vbExclamation Exit For End If cel.EntireRow.Copy Destination:=trg.Offset(1) cel.EntireRow.Delete Range("A1").CurrentRegion.Sort Key1:=Range("C1"), Header:=xlYes End If Next cel Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub
HansVogelaar
Jul 12, 2024MVP
I get "Access Denied".
christopherwhiten
Jul 12, 2024Copper Contributor
Try it now, I changed the persmissions to anyone with the link.
- HansVogelaarJul 12, 2024MVP
Right-click the sheet tab.
Select 'View Code' from the context menu.
Copy the code listed below into the worksheet module,
Switch back to Excel.
Save the workbook as a macro-enabled workbook (*.xlsm).
Make sure that you allow macros when you open it.
Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Dim cel As Range Dim trg As Range Set rng = Intersect(Range("D18:D30"), Target) If Not rng Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False For Each cel In rng If cel.Value = "DONE" Then Set trg = Range("A18").End(xlUp) If trg.Row = 1 Then MsgBox "No more room!", vbExclamation Exit For End If cel.EntireRow.Copy Destination:=trg.Offset(1) cel.EntireRow.Delete Range("A1").CurrentRegion.Sort Key1:=Range("C1"), Header:=xlYes End If Next cel Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub
- christopherwhitenJul 12, 2024Copper ContributorHans,
That is exactly what I was needing. How would I keep the conditional formatting for the Green highlighting from columns A to N once it is moved?- HansVogelaarJul 12, 2024MVP
There is something strange going on there - if you look at Conditional Formatting > Manage Rules, you'll see that the rule is there. But it isn't applied.
After I used the Format Painter button to copy the formatting of one of the other rows, it started working again.
I don't have an explanation for this behavior...
- HansVogelaarJul 12, 2024MVP
Thanks, that works. I will take a look.