Add new row according to the number key in

lala_milo · Jan 24th 2017

I try to add new row according to the number key in without button but failed

Example, when user key in 2 in column A2, it will add 2 row in below. If user key in 4 in column A2 will add 4 row in below. If user change the number in column A2 from 4 to 1 then will delete 3 row

Currently i using simple code as below

Code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


    Application.ScreenUpdating = False
    Application.DisplayAlerts = False




    If Not Intersect(Target, Range("M6:M10000")) Is Nothing Then
     Cancel = True 'Prevent going into Edit Mode
        Target.Font.Name = "Marlett"
        If Target = vbNullString Then
           Target = "a"
            Target.Offset(1).EntireRow.Insert
          Else
           Target = vbNullString
        End If
    End If
    
    Application.ScreenUpdating = True
End Sub

Display More

NoSparks · Jan 24th 2017

Re: Add new row according to the number key in

Try this... it uses an extra column to keep track of the 'previous' numbers of column A in order to know how many rows for deletions.
I've used column P as the extra.

Code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
     
    If Not Intersect(Target, Range("M6:M10000")) Is Nothing Then
        Cancel = True 'Prevent going into Edit Mode
        prev = Cells(Target.Row, "P").Value     'col A previous number
        cur = Cells(Target.Row, "A").Value  'the new number
        If cur > prev Then
            Target.Font.Name = "Marlett"
            Target = "a"
            Target.Offset(1).Resize(cur).EntireRow.Insert
        ElseIf cur < prev Then
            Target = vbNullString
            Target.Offset(1).Resize(prev - cur).EntireRow.Delete
        End If
        ' preserve the col A values as prev
        Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Copy Range("P2")
    End If
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

Display More

Add new row according to the number key in

Participate now!

Share