CODEWITHSUNDEEP
vbaexcelinsertconditional-formatting
AdRock
AdRock

Reputation: 3096

Excel VBA to insert/delete rows at end of range

I need to insert or delete some rows depending on what a variable states.

Sheet1 has a list of data. With sheet2 which is formatted, i want to copy that data so sheet2 is just a template and sheet1 is like a user form.

What my code does up until the for loop is get the number of rows in sheet 1 which only contains data and also the number of rows in sheet2 which contains data.

If the user adds some more data to sheet1 then i need to insert some more rows at the end the data in sheet2 and if the user deletes some rows in sheet1 the rows are deleted from sheet2.

I can get the number of rows on each so now how many to insert or delete but that's where i've come unstuck. How would I insert/delete the correct amount of rows. Also i wanted to alternate the rows colours between white and grey.

I did think that it might be an idea to delete all the rows on sheet2 then insert the same amount of rows that are in sheet1 using the alternating row colours but then again i did see something about using mod in the conditional formatting.

Can anyone please help?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim listRows As Integer, ganttRows As Integer, listRange As Range, ganttRange As Range
    Dim i As Integer


    Set listRange = Columns("B:B")
    Set ganttRange = Worksheets("Sheet2").Columns("B:B")

    listRows = Application.WorksheetFunction.CountA(listRange)
    ganttRows = Application.WorksheetFunction.CountA(ganttRange)

    Worksheets("Sheet2").Range("A1") = ganttRows - listRows

    For i = 1 To ganttRows - listRows
        'LastRowColA = Range("A65536").End(xlUp).Row


    Next i

    If Target.Row Mod 2 = 0 Then
        Target.EntireRow.Interior.ColorIndex = 20
    End If

End Sub

Upvotes: 0

Views: 7703

Answers (1)

Scott Holtzman
Scott Holtzman

Reputation: 27259

I didn't test this, because I didn't have sample data, but try this out. You may need to change some of the cell referencing to fit your needs.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim listRows As Integer, ganttRows As Integer, listRange As Range, ganttRange As Range
    Dim wks1 As Worksheet, wks2 As Worksheet

    Set wks1 = Worksheets("Sheet2")
    Set wks2 = Worksheets("Sheet1")

    Set listRange = Intersect(wks1.UsedRange, wks1.columns("B:B").EntireColumn)
    Set ganttRange = Intersect(wks2.UsedRange, wks2.columns("B:B").EntireColumn)

    listRows = listRange.Rows.count
    ganttRows = ganttRange.Rows.count

    If listRows > ganttRows Then 'sheet 1 has more rows, need to insert
        wks1.Range(wks1.Cells(listRows - (listRows - ganttRows), 1), wks1.Cells(listRows, 1)).EntireRow.Copy 
       wks2.Cells(ganttRows, 1).offset(1).PasteSpecial xlPasteValues
    ElseIf ganttRows > listRows 'sheet 2 has more rows need to delete
        wks2.Range(wks2.Cells(ganttRows, 1), wks2.Cells(ganttRows - (ganttRows - listRows), 1)).EntireRow.Delete
    End If

    Dim cel As Range
    'reset range because of updates
    Set ganttRange = Intersect(wks2.UsedRange, wks2.columns("B:B").EntireColumn)

    For Each cel In ganttRange
        If cel.Row Mod 2 = 0 Then cel.EntireRow.Interior.ColorIndex = 20
    Next

End Sub

UPDATE

Just re-read this line 

If the user adds some more data to sheet1 then i need to insert some more rows at the end the data in sheet2 and if the user deletes some rows in sheet1 the rows are deleted from sheet2.

My solution is based on if the user insert / deletes rows at the bottom of the worksheet. If the user inserts / deletes rows in the middle, you are better off copy the entire range from sheet1 and onto a cleared out sheet2.

Upvotes: 1

Related Questions