Using VBA to insert or delete row and column automatic

Dear all,
I am newbie.
Help me write VBA code for insert or delete row and column automatic. Pls see detail attachment file.
I have a report display on a sheet, inclued 2 tables, each table have 6 columns and 1 fixed row, i want to rows of 2 tables change (insert or delete, except to fixed row) with F4 and F5 cell condition.
Thank your very much.

David Lee

AttachmentSize
Bcaonew.xls20 KB
Vishesh's picture

Solved

Just create two named ranges: rngLeftInternal (C8) and rngLeftColb (C20) and paste the following code in sheet1 code module. 

 

Option Explicit
 
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim rngIntersect As Range
 
On Error Resume Next
 
    Set rngIntersect = Intersect(Target, Sheet1.Range("F2"))
 
On Error GoTo 0
 
    If Not rngIntersect Is Nothing Then
 
        Application.ScreenUpdating = False
 
        Call SetTables(Range("rngLeftInternal"), Range _
          ("rngLeftColb").Offset(-4), Range _
          ("rngLeftInternal").Parent.Range("F4").Value)
 
 
        Call SetTables(Range("rngLeftColb"), Range _
           ("rngLeftColb").Offset(50), Range _
           ("rngLeftInternal").Parent.Range("F5").Value)
 
        Application.ScreenUpdating = True
 
    End If
 
    Set rngIntersect = Nothing
 
End Sub
 
 
 
Sub SetTables(rngStart As Range, rngEnd As Range, _
 intRowCount As Integer)
 
    Dim intStRow    As Integer
 
    Dim intEndRow   As Integer
 
 
 
    intStRow = rngStart.Offset(1).Row
 
    intEndRow = rngEnd.Row
 
    If intEndRow > intStRow Then
 
        rngStart.Parent.Rows(intStRow & ":" & intEndRow).Delete
 
    End If
 
    If intRowCount > 0 Then
 
        rngStart.Offset(2).Resize(intRowCount).EntireRow.Insert
 
        Call SetTableBorder(rngStart.Resize(intRowCount + 1, 6))
 
    End If
 
End Sub
 
 
 
Sub SetTableBorder(rng As Range)
 
    rng.Borders(xlDiagonalDown).LineStyle = xlNone
 
    rng.Borders(xlDiagonalUp).LineStyle = xlNone
 
    With rng.Borders(xlEdgeLeft)
 
        .LineStyle = xlContinuous
 
        .Weight = xlThin
 
        .ColorIndex = xlAutomatic
 
    End With
 
    With rng.Borders(xlEdgeTop)
 
        .LineStyle = xlContinuous
 
        .Weight = xlThin
 
        .ColorIndex = xlAutomatic
 
    End With
 
    With rng.Borders(xlEdgeBottom)
 
        .LineStyle = xlContinuous
 
        .Weight = xlThin
 
        .ColorIndex = xlAutomatic
 
    End With
 
    With rng.Borders(xlEdgeRight)
 
        .LineStyle = xlContinuous
 
        .Weight = xlThin
 
        .ColorIndex = xlAutomatic
 
    End With
 
    With rng.Borders(xlInsideVertical)
 
        .LineStyle = xlContinuous
 
        .Weight = xlThin
 
        .ColorIndex = xlAutomatic
 
    End With
 
    With rng.Borders(xlInsideHorizontal)
 
        .LineStyle = xlContinuous
 
        .Weight = xlThin
 
        .ColorIndex = xlAutomatic
 
    End With
 
End Sub
Nick's picture

Delete Rows

Hi David

your request is well specified, and we'd be happy to help you out.

Unfortunately, this is a bit too much work to do it for free.

So, you have 2 options:

  1. Ask for a quote
  2. A kind ExcelExperts member might help you out for free... (But you'll probably have to wait)

Rgds

Nick