Results 1 to 2 of 2

Thread: EXCEL Insert missing numbers for sequence with VBA code

  1. #1

    EXCEL Insert missing numbers for sequence with VBA code



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Need help to modify this script from ExtendOffice It inserts rows of missed data in sequence of rows , but do it only for 2 columns ID and NAME. How i need to modify this script that it works with different number of Columns?

    ID NAME NEW
    1 name1 new1
    3 name3 new3
    5 name4 new4
    6 name5 new5

    ID NAME NEW
    1 name1 new1
    2
    3 name3 new3
    4
    5 name4 new4
    6 name5 new5

    Code:
    SubInsertValueBetween()'Update 20130825
    Dim WorkRng As Range
    Dim Rng As Range
    Dim outArr As Variant
    Dim dic As Variant
    Set dic = CreateObject("Scripting.Dictionary")
    'On Error Resume Next
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    num1 = WorkRng.Range("A1").Value
    num2 = WorkRng.Range("A" & WorkRng.Rows.Count).Value
    interval = num2 - num1
    ReDim outArr(1 To interval + 1, 1 To 2)
    For Each Rng In WorkRng
    dic(Rng.Value) = Rng.Offset(0, 1).Value
    Next
    For i = 0 To interval
    outArr(i + 1, 1) = i + num1
    If dic.Exists(i + num1) Then
    outArr(i + 1, 2) = dic(i + num1)
    Else
    outArr(i + 1, 2) = ""
    End If
    Next
    With WorkRng.Range("A1").Resize(UBound(outArr, 1), UBound(outArr, 2))
    .Value = outArr
    .Select
    End With
    End Sub

  2. #2
    Code:
    Sub InsertValueBetween()Dim lastrow As Long
    Dim gap As Long
    Dim i As Long, ii As Long
    
    
        Application.ScreenUpdating = False
        
        With ActiveSheet
        
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            For i = lastrow To 3 Step -1
            
                gap = .Cells(i, "A").Value - .Cells(i - 1, "A").Value
                If gap > 1 Then
                
                    .Rows(i).Resize(gap - 1).Insert
                End If
            Next i
            
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Cells(3, "A").Value = .Cells(2, "A").Value + 1
            .Cells(2, "A").Resize(2).AutoFill .Cells(2, "A").Resize(lastrow - 1)
        End With
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •