excel VBA macro to add and subtract rows from protected sheet

Hi Experts,

I need a macro that will add or delete rows in three different sections of a protected sheet. The sample sheet is attached. basically if a i click the add row button i want it to add a single row under the active cell in the first green section (row 7-17) and also add corresponding rows in the other two green sections (rows 58-68 and 169-179) Likewise if i click the delete row button i want it to delete delete the row with the active cell (provided it is located somewhere in the top green section) and the corresponding rows in the other two green sections.
romligAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
You forgot to attach the sheet.
0
romligAuthor Commented:
0
Martin LissOlder than dirtCommented:
OK here is my attempt at adding the row. If my change is what you want then I'll do the delete row part. Note that I commented out the original code but I can work it in if you can tell me it's purpose.
28693016.xlsm
0
Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

romligAuthor Commented:
Martin,  That works great exactly what i am looking for. No need to work in the original code if you don't need it. ( i just copied it from another sheet i use.)
0
Martin LissOlder than dirtCommented:
Sub DeleteRow()
' Delete a row
Dim lngRow As Long
Dim lngLastGreenRow As Long
Dim lngSelectedRow As Long

With ActiveSheet
    lngSelectedRow = ActiveCell.Row
    
    ' Find the last green row in the top section
    For lngRow = 7 To .UsedRange.Rows.Count
        If .Cells(lngRow, "B").Interior.Color <> 13434828 Then
            lngLastGreenRow = lngRow - 1
            Exit For
        End If
    Next
    
    If Intersect(ActiveCell, .Range("A7:F" & lngLastGreenRow)) Is Nothing Then
        MsgBox "Row not deleted. Please chose a cell in the first green section."
        Exit Sub
    End If
    
    ' Delete the row that contains the activece cell
    ActiveCell.EntireRow.Delete
    
    ' Find the next section
    For lngRow = lngLastGreenRow + 2 To .UsedRange.Rows.Count
        If .Cells(lngRow, "F").Interior.Color = 13434828 Then
            Exit For
        End If
    Next
    
    ' Delete the relative row
    lngRow = lngRow + ActiveCell.Row - 7
    .Cells(lngRow, 1).EntireRow.Delete
    
    ' Find the last green row in the second section
    For lngRow = lngRow To .UsedRange.Rows.Count
        If .Cells(lngRow, "F").Interior.Color <> 13434828 Then
            lngLastGreenRow = lngRow - 1
            Exit For
        End If
    Next
    
    ' Find the next section
    For lngRow = lngLastGreenRow + 2 To .UsedRange.Rows.Count
        If .Cells(lngRow, "F").Interior.Color = 13434828 Then
            Exit For
        End If
    Next
    
    ' Delete the relative row
    lngRow = lngRow + lngSelectedRow - 7
    .Cells(lngRow, 1).EntireRow.Delete
    
   ' Select the cell below the original selection
   .Cells(lngSelectedRow + 1, "B").Select
End With
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
romligAuthor Commented:
Excellent solution did exactly what i needed no errors, no issues and even works in office 2011 for Mac!  
thanks Martin !!!!
0
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.