Add multiple new rows with different data

[zack8576]

I need add 3 rows to the end of an excel file, and fill columns A-D with certain values
I know the code below can add one row and fill them with values

 lr = Cells(Rows.Count, 1).End(xlUp).Row
Public lr As Long, lr2 As Long
  lr2 = lr + 1
    Cells(lr2, "A") = "One"
    Cells(lr2, "B") = "Two"
    Cells(lr2, "C") = "Three"
    Cells(lr2, "D") = "Four"

Is below the right way to add 3 new rows, and fill each cell in these rows with different values ?

 lr = Cells(Rows.Count, 1).End(xlUp).Row
Public lr As Long, lr2 As Long
  lr2 = lr + 3
    Cells(lr2, "A") = "One", "One", "Five"
    Cells(lr2, "B") = "Two", "Six", "Seven"
    Cells(lr2, "C") = "Three", "Eight", "Nine"
    Cells(lr2, "D") = "Four", "Ten", "Eleven"

 

[zack8576]

Try this:

Sub WrapidSeal()
    Dim lrNewRows As Long
    lrNewRows = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    sr = 2
    n = Application.Sum(Application.SumIfs(Range("C" & sr & ":C" & lr), Range("K" & sr & ":K" & lr), _
    Array("*Base*", "*Riser*", "*Cone*", "*Top Slab*"), Range("O" & sr & ":O" & lr), "*SANITARY*"))
   
    With Columns("A:K")
            lrNewRows = lrNewRows + 1
        .Rows(lrNewRows) = Array(Cells(lr, "A"), ".", n - 1, "F25888A", "No", """", """", """", "Purchased", """", "Closure")
        If Cells(lrNewRows, "C").Value = 0 Then
            Cells(lrNewRows, "D") = ","
        End If
            lrNewRows = lrNewRows + 1
        .Rows(lrNewRows) = Array(Cells(lr, "A"), ".", (n - 1) / 8, "F25889A", "No", """", """", """", "Purchased", """", "Primer")
        If Cells(lrNewRows, "C").Value = 0 Then
            Cells(lrNewRows, "D") = ","
        End If
            lrNewRows = lrNewRows + 1
        .Rows(lrNewRows) = Array(Cells(lr, "A"), ".", """", "F25890A", "No", """", """", """", "Purchased", """", "Wrapid-Seal")
    End With

End Sub

This works great, thanks a lot !

 

[zack8576]

Try this:

Sub WrapidSeal()
    Dim lrNewRows As Long
    lrNewRows = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    sr = 2
    n = Application.Sum(Application.SumIfs(Range("C" & sr & ":C" & lr), Range("K" & sr & ":K" & lr), _
    Array("*Base*", "*Riser*", "*Cone*", "*Top Slab*"), Range("O" & sr & ":O" & lr), "*SANITARY*"))
   
    With Columns("A:K")
            lrNewRows = lrNewRows + 1
        .Rows(lrNewRows) = Array(Cells(lr, "A"), ".", n - 1, "F25888A", "No", """", """", """", "Purchased", """", "Closure")
        If Cells(lrNewRows, "C").Value = 0 Then
            Cells(lrNewRows, "D") = ","
        End If
            lrNewRows = lrNewRows + 1
        .Rows(lrNewRows) = Array(Cells(lr, "A"), ".", (n - 1) / 8, "F25889A", "No", """", """", """", "Purchased", """", "Primer")
        If Cells(lrNewRows, "C").Value = 0 Then
            Cells(lrNewRows, "D") = ","
        End If
            lrNewRows = lrNewRows + 1
        .Rows(lrNewRows) = Array(Cells(lr, "A"), ".", """", "F25890A", "No", """", """", """", "Purchased", """", "Wrapid-Seal")
    End With

End Sub

I needed to add an If statement in this routine, and I spent a couple of hours trying to figure out why this is not working.
basically when column K contains keyword "9" and "Wrapid-seal", then proceed with the calculation for n, otherwise n = 0
see below, the code is acting like these keywords are not in the test file (attached), and n is returning as 0 every time. any idea why?

Sub WrapidSealSmall()
    Dim lrNew As Long, i As Long
    lrNew = ActiveSheet.Range("K" & Rows.Count).End(xlUp).Row
    sr = 2
    
    For i = 2 To lastRow
        If Range("K" & i).Value Like "*9*" And _
           Range("K" & i).Value Like "*Wrapid-Seal*" Then
            n = Application.Sum(Application.SumIfs(Range("C" & sr & ":C" & lr), Range("K" & sr & ":K" & lr), _
            Array("*Base*", "*Riser*", "*Cone*", "*Top Slab*"), Range("O" & sr & ":O" & lr), "*SANITARY*"))
        Else
            n = 0
        End If
    Next i
    
    With Columns("A:K")
            lrNew = lrNew + 1
        .Rows(lrNew) = Array(Cells(lr, "A"), ".", n - 1, "F25888A", "No", """", """", """", "Purchased", """", "9"" Closure")
        If Cells(lrNew, "C").Value = 0 Or _
            Cells(lrNew, "C").Value < 0 Then
            Cells(lrNew, 4) = ","
        End If
            lrNew = lrNew + 1
        .Rows(lrNew) = Array(Cells(lr, "A"), ".", (n - 1) / 8, "F25889A", "No", """", """", """", "Purchased", """", "Primer")
        If Cells(lrNew, "C").Value = 0 Or _
           Cells(lrNew, "C").Value < 0 Then
            Rows(lrNew).Delete
        End If
            lrNew = lrNew + 1
        .Rows(lrNew) = Array(Cells(lr, "A"), ".", """", "F51040", "No", """", """", """", "Purchased", """", "9"" Wrapid-Seal")
        If n = 0 Then
            Rows(lrNew).Delete
        End If
    End With
End Sub

2022080011 SANITARY.csv

Shared with Dropbox

www.dropbox.com

 

[Peter_SSs]

Since post #12 is a duplicate to your new thread If a cell contain a string then do THIS otherwise do THAT I am closing this one.

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.