Forum Discussion

ajmal_pottekattil_yoousuf's avatar
ajmal_pottekattil_yoousuf
Iron Contributor
Nov 15, 2022
Solved

How to add the Rows and table automatically

please refer to the video and excel sheet. is it possible to create the like that the video.
excel
Excel for web
Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Nov 21, 2022

    ajmal_pottekattil_yoousuf 

    After downloading the workbook, right-click it in Windows Explorer and select Properties from the context menu. If you see Unblock, click it, then click OK.

    You may also want to make the folder containing the workbook a trusted location for Excel (File > Options > Trust Center > Trust Center Settings... > Trusted Locations)

HansVogelaar's avatar
HansVogelaar
MVP
Nov 21, 2022

ajmal_pottekattil_yoousuf 

Right-click the sheet tab and select 'View Code' from the context menu.

Change the Worksheet_Change event procedure to

Private Sub Worksheet_Change(ByVal Target As Range)
    Const MaxRows = 10
    Dim NumRows As Long
    If Not Intersect(Range("D2"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Range("C6:E" & MaxRows + 5).Clear
        NumRows = Val(Range("D2").Value)
        If NumRows < 1 Then Exit Sub
        If NumRows > MaxRows Then
            MsgBox "The maximum is " & MaxRows, vbExclamation
            Exit Sub
        End If
        Range("C6:E" & NumRows + 5).Borders.LineStyle = xlContinuous
        Range("E6:E" & NumRows + 5).Formula = "=D6-C6"
        Application.ScreenUpdating = True
    End If
End Sub
  • ajmal_pottekattil_yoousuf's avatar
    ajmal_pottekattil_yoousuf
    Iron Contributor
    Nov 25, 2022

    it is working,
    While adding the rows or delete rows the deviation (D6-C6) Values is disappearing.

     

    • HansVogelaar's avatar
      HansVogelaar
      MVP
      Nov 25, 2022

      ajmal_pottekattil_yoousuf 

      New version:

      Private Sub Worksheet_Change(ByVal Target As Range)
    Const MaxRows = 10
    Dim NumRows As Long
    Dim LastRow As Long
    If Not Intersect(Range("D2"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        LastRow = Range("E" & MaxRows + 6).End(xlUp).Row
        NumRows = Val(Range("D2").Value)
        If NumRows < 1 Then Exit Sub
        If NumRows > MaxRows Then
            MsgBox "The maximum is " & MaxRows, vbExclamation
            Exit Sub
        End If
        If LastRow > NumRows + 5 Then
            Range("C" & NumRows + 6 & ":E" & LastRow).Clear
        End If
        Range("C6:E" & NumRows + 5).Borders.LineStyle = xlContinuous
        Range("E6:E" & NumRows + 5).Formula = "=D6-C6"
        Application.ScreenUpdating = True
    End If
End Sub

Resources