VBA Code to Insert Rows Based on Cell Value

[rq41285]

Hello,

I am a VBA beginner and looking to write a code to insert x number of roles based on every time the value of a cell in Sheet1 Column B is not "100" or blank, and count of an ID number in Sheet2 column A (minus 1). Further explanation below.

Example Data

Sheet1
[TABLE="width: 500"]
<tbody>[TR]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ID #
[/TD]
[TD]Percentage
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1100
[/TD]
[TD]50
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1200
[/TD]
[TD]100
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1300
[/TD]
[TD]-
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1400
[/TD]
[TD]-
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1500
[/TD]
[TD]100
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1600
[/TD]
[TD]75
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1700
[/TD]
[TD]75
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1800
[/TD]
[TD]100
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



Sheet 2
[TABLE="width: 500"]
<tbody>[TR]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[TD]Column C
[/TD]
[TD]Column D
[/TD]
[/TR]
[TR]
[TD]ID #
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1100
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1100
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1100
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1200
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1500
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1700
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1700
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1700
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Example:
Macro finds that Sheet1 ID# 1100 is "50" in column b (which is not 100 or blank) and then inserts 2 rows (3 minus 1) under 1100 in Sheet1 because Sheet2 has three occurrences of "1100" in column A

 

[thes4s67]

This should work but the thing is I can't think of the code to insert the row for some reason >_<

Hopefully someone will figure it out...

Sub test()
Dim rng1 As Range
Dim num As Long, count As Long

'Change the ranges to reflect your own.

Set rng1 = Sheets("Sheet1").Range("B1:B5")


For Each cell In rng1.Cells
  If Not cell.Value = "100" And Not cell.Value = "" Then
    num = Cells(cell.Row, 1).Value
    count = Application.WorksheetFunction.CountIf(Sheets("Sheet2").Range("A1:A16"), num)
    For i = 1 To num
    'Insert Rows
    Next i
  End If
Next


End Sub

 

[MARK858]

Possibly....

Sub test2()
    Dim lRow As Long, rng2 As Range
    Dim num As Long, cRow As Long
    Application.ScreenUpdating = False

    Set rng2 = Sheets("Sheet2").Range("A2:A" & Sheets("Sheet2").Range("A" & Rows.count).End(xlUp).Row)

    For lRow = Sheets("Sheet1").Range("A" & Rows.count).End(xlUp).Row To 2 Step -1

        If Not Sheets("Sheet1").Cells(lRow, "b").Value = "100" And Not Sheets("Sheet1").Cells(lRow, "b").Value = "" Then
            num = Sheets("Sheet1").Cells(lRow, "b").Offset(0, -1).Value
            cRow = Application.WorksheetFunction.CountIf(rng2, num)
            If cRow > 1 Then Sheets("Sheet1").Cells(lRow, "b").Offset(1).Resize(cRow - 1, 1).EntireRow.Insert
        End If

    Next

    Application.ScreenUpdating = True
End Sub