CODEWITHSUNDEEP
vbaexcel
matt
matt

Reputation: 75

VBA Insert string after inserting row

I'm trying to accomplish two things; 1) insert rows (and a number in A1) based on a sequential pattern 2) insert the string value of "NA" in the remaining columns of the inserted row. I'm using the script below, part 1 works but part 2 is putting "NA" in all of the columns rather than whats used within the worksheet. Here's a sample of the data:

2001    A   A   A
2002    A   A   A
2004    A   A   A
2005    A   A   A

the code should insert 2003 AFTER 2002 with "NA" in columns B:D

Here's the script that I'm currently using: 

Sub test()
Dim i As Long, x, r, cell, CRange As Range
Dim InputValue As String
InputValue = "NA"
'test for sequential number
For i = Range("a" & Rows.Count).End(xlUp).Row To 2 Step -1
    x = Cells(i, 1) - Cells(i - 1, 1)
    If x > 1 Then
        Rows(i).Resize(x - 1).Insert
    End If
Next
'insert row if not sequential
For Each r In Range("a1", Range("a" & Rows.Count) _
    .End(xlUp)).SpecialCells(4).Areas
    With r.Cells(1).Offset(-1)
        .AutoFill .Resize(r.Rows.Count + 1), 2
    End With
        'Test for empty cell. If empty, fill cell with value given
        For Each cell In Selection
            If IsEmpty(cell) Then
            cell.Value = InputValue
            End If
        Next
Next
End Sub

Upvotes: 1

Views: 1941

Answers (3)

Aaron Thomas
Aaron Thomas

Reputation: 5281

If no more than one year is missing at a time between years in column A:

'Go through each cell in column A that has values
For Each cl In Range("A2", Cells(Rows.Count, "A").End(xlUp))
  'If not expected, then...
  If cl.Value <> (cl.Offset(-1, 0).Value + 1) Then
    'Insert the new row
    cl.Insert shift:=xlShiftDown
    'Put an expected value in the new blank row, column A
    cl.Offset(-1, 0).Value = (cl.Offset(-2, 0).Value + 1)
    'Fill in "NA" across the other cells
    Range(cl.Offset(-1, 1), cl.Offset(-1, 3)).Value = "NA"
  End If
Next

Range(cl.Offset(-1, 1), cl.Offset(-1, 3)).Value = "NA" is what fills in "NA". You can fill across multiple cells at once using Range.Value.

Upvotes: 0

tigeravatar
tigeravatar

Reputation: 26640

Only use one loop to insert the rows, then fill in the new blanks with NA and recreate the number sequence:

Sub tgr()

    Dim rngNew As Range
    Dim rIndex As Long
    Dim lDifference As Long

    For rIndex = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        lDifference = Cells(rIndex, "A").Value - Cells(rIndex - 1, "A").Value
        If lDifference > 1 Then
            Rows(rIndex).Resize(lDifference - 1).Insert
            Select Case (rngNew Is Nothing)
                Case True:  Set rngNew = Rows(rIndex).Resize(lDifference - 1)
                Case Else:  Set rngNew = Union(rngNew, Rows(rIndex).Resize(lDifference - 1))
            End Select
        End If
    Next rIndex

    Intersect(Range("A1").CurrentRegion.EntireColumn, rngNew).Value = "NA"

    With Range("A2", Cells(Rows.Count, "A").End(xlUp))
        .Formula = "=A1+1"
        .Value = .Value
    End With

End Sub

Upvotes: 0

Joe Laviano
Joe Laviano

Reputation: 1048

Your range is only in the A column, which is your years. Therefore, when it goes to select an empty cell, there won't be any. You can change to something like:

For Each r In Range("a1", Range("a" & Rows.Count) _
.End(xlUp)).SpecialCells(4).Areas
With r.Cells(1).Offset(-1)
    .AutoFill .Resize(r.Rows.Count + 1), 2
End With
    'Test for empty cell. If empty, fill cell with value given
'Change comes in under this comment.
    For Each cell In Range("a1", Range("d" & Rows.Count) _
.End(xlUp))
        If IsEmpty(cell) Then
        cell.Value = InputValue
        End If
    Next
Next

The key is the column change in the second loop, which can be changed to what you need.

Upvotes: 1

Related Questions