'Is it possible to have multiple loops that run independently?

I am trying to insert 2 different ranges "x" amount of times based on the input from the user. The user chooses how many mounts they need "D22" and a range is copied and inserted x amount of times, then how many "bobbins" they need "D23" and a range is copied and inserted x amount of times, if there is already a value in "D23" and a new number is typed into "D22" then the code will work, however if the cells are blank and a value is typed into both "D22" and "D23" , only the range for "D22" will populate. I have included my code below. I'm a beginner so forgive any blatant errors

Sub Worksheet_Change(ByVal Target As Range)
        Dim NM As Long
        Dim NB As Long
        Dim FL As Long
        Dim lRow As Long
        Dim lCol As Long
        Dim M As Variant
        Dim CheckVal As Variant
        Dim i As Integer
        Dim a As Integer
        Dim j As Integer
        Dim b As Integer
        Dim sht1 As Worksheet
        Dim sht2 As Worksheet
        Dim R As Range
        Set sht1 = Worksheets("Calculation")
        Set sht2 = Worksheets("Hidden 1")
    
                NM = sht1.Range("D22").Valu
                     sht1.Range("A27:F27").Resize(NM + 100).EntireRow.Delete Shift:=xlUp
                    i = NM 'where to find the value for how many mounts
                   
                NB = sht1.Range("D23").Value
                    j = NB 'where to find the value for how many bobbins
                  

              a = 1
              Do Until a > i
              sht2.Range("A38:F41").Copy 'select the range you want to copy

              With sht1.Range("A27").Insert
               a = a + 1
              
              If a > i Then Exit Do
              End With
              Loop
              
        
              lRow = Cells(Rows.Count, 1).End(xlUp).Row
              lCol = Cells(1, Columns.Count).End(xlToLeft).Column
              Set R = sht1.Range(sht1.Cells(lRow, lCol).Offset(2, 0).Address)
              
              b = 1
              Do Until b > j
              
              sht2.Range("A43:F46").Copy 'select the range you want to copy
              
              With R.Insert
              b = b + 1
        
              End With
              Loop
              End If
              
End Sub


Solution 1:[1]

I would suggest splitting these two ideas into their own separate macros. They can individually be triggered by different cells being changed on the worksheet by monitoring the Worksheet_Change event and checking Target.

Intersect returns any cells that are shared by the two ranges. This is a quick way to check one if the changed cells in the event was D22 or D23. If it was, Intersect will not be Nothing, because it will be D22 or D23!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("D22")) Is Nothing Then
        InsertMounts Me.Range("D22").Value
    ElseIf Not Intersect(Target, Me.Range("D23")) Is Nothing Then
        InsertBobbins Me.Range("D23").Value
    End If
End Sub

Sub InsertMounts(Amount As Long)
    Dim sht1 As Worksheet, sht2 As Worksheet
    Set sht1 = Worksheets("Calculation")
    Set sht2 = Worksheets("Hidden 1")
    
    For a = 1 To Amount
        sht2.Range("A38:F41").Copy 'select the range you want to copy
        sht1.Range("A27").Insert
    Next
    
End Sub
Sub InsertBobbins(Amount As Long)
    Dim sht1 As Worksheet, sht2 As Worksheet
    Set sht1 = Worksheets("Calculation")
    Set sht2 = Worksheets("Hidden 1")
    
    Dim lRow As Long, lCol As Long, R As Range
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column
    Set R = sht1.Range(sht1.Cells(lRow, lCol).Offset(2, 0).Address)
    
    For b = 1 To Amount
        sht2.Range("A43:F46").Copy 'select the range you want to copy
        R.Insert
    Next
End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Toddleson