Macro to insert # of row specific in a cell

[Baboo]

Hi All,

hope someone can help to achieve the below.
I am working on an excel file as attached file, tiger.xls
this is what i am trying to accomplish to write in Marco.

Part A:
in the H column, i need to insert the # of row minus the number that is in the cell. for ex. when
H2 = 3, to insert 2 blank row down
H3 = 2, to insert 1 blank row down

however, if the cell is 1, then do not add any row

Inserting the blank row should come to a STOP whenit reaches [Total] on colunm A.
when this is done, the file shouuld like file as attached: lion.xls

Part B:
Auto populate the number in an increasement format in the empty cells follow by the Max# in Column A.

in this example, in Colunm A the max# is 10. so
the first empty cell [A3]l should be listed as 11.
The increasment should be carried on, unitl it reaches a smaller number.
in this case:

A3 = 11
A4 = 12
A5 = 2

stop, and then

A6 = continue to auto populate [increasement] from last Max #
which means, A6 = 13

auto populate number should be stopped when it reaches to the cell [Total]

the final file should look like as attached, bear.xls

Appreciate for any thoughts and comment.

Regards

[TMS]

For the first part:

Sub InsertRows()

Dim s2LastRow As Long
Dim i As Long
s2LastRow = Range("F" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
For i = s2LastRow To 2 Step -1
    If Range("H" & i).Value > 1 Then
        Range("H" & i).Offset(1, 0).Resize(Range("H" & i) - 1, 1).EntireRow.Insert
    End If
Next 'i
Application.ScreenUpdating = True

End Sub

Regards

[Marcol]

Try this with your Sheet "Tiger"

Option Explicit

Sub AddRowsAndNumberNewRows()
    Dim LastRow As Long, RowNo As Long, RowsAdd As Long
    Dim NewRowNo As Long
    Dim wsTiger As Worksheet

    Set wsTiger = Sheets("Tiger")

    With wsTiger
        LastRow = .Range("H" & Rows.Count).End(xlUp).Row
        For RowNo = LastRow To 3 Step -1
            For RowsAdd = 1 To CInt(.Range("H" & RowNo - 1)) - 1
                .Rows(RowNo).Insert Shift:=xlDown
            Next
        Next
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        NewRowNo = WorksheetFunction.Max(Range("A2:A" & LastRow)) + 1
        For RowNo = 2 To LastRow
            If .Range("A" & RowNo) = "" Then
                .Range("A" & RowNo) = NewRowNo
                .Range("A" & RowNo).Font.ColorIndex = 1
                NewRowNo = NewRowNo + 1
            End If
        Next
    End With
    
End Sub

[Baboo]

TMShucks and Marcol, it works perfectly! you guys are awesome! thanks.

[Marcol]

Happy to help.

[TMS]

You're welcome.

[Baboo]

You're welcome.

I am greedy... and want to to build the Marco from scratch with the oringal file: see file as: Monkey.xls

Part 1:
Re-listing from A2 in order (1,2,3) - stop when it reaches [Total]

Part 2:
Insert 3 column after [G column]
the new columns need to be named as follow:

new [H column] "Carton (Qty.)"
new [I column] "Case Number"
new [J column] "Carton Label #"

Next, action the code that written by Marcol (addrow and number new row]

After this, I need to add one more Marco:

in Column J, from:
J2 = listing as: Carton 1 of (Max#) in column A
J3 - listing as: Carton 2 of (Max#) in column A

Continue and stop when the [Total] is reached in column A

the final file should look like as attached: wolf.xls

[NBVC]

Please stop editing your title... this is the 3rd time that I fixed it... just add your new post to the thread and somebody will look at it.

Thank you!

[Baboo]

Please stop editing your title... this is the 3rd time that I fixed it... just add your new post to the thread and somebody will look at it.

Thank you!

new user here....sorry for the inconvenience it caused to you and thanks for the fixed.

[Marcol]

Try this with your Sheet "Tiger"

Option Explicit

Sub AddRowsAndNumberNewRows()
    Dim LastRow As Long, RowNo As Long, RowsAdd As Long
    Dim NewRowNo As Long
    Dim wsTiger As Worksheet

    Set wsTiger = Sheets("Tiger")

    With wsTiger
        LastRow = .Range("H" & Rows.Count).End(xlUp).Row
        For RowNo = LastRow To 3 Step -1
            For RowsAdd = 1 To CInt(.Range("H" & RowNo - 1)) - 1
                .Rows(RowNo).Insert Shift:=xlDown
            Next
        Next
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        NewRowNo = WorksheetFunction.Max(Range("A2:A" & LastRow)) + 1
        For RowNo = 2 To LastRow
            If .Range("A" & RowNo) = "" Then
                .Range("A" & RowNo) = NewRowNo
                .Range("A" & RowNo).Font.ColorIndex = 1
                NewRowNo = NewRowNo + 1
            End If
        Next
        With .Range("J2")
            .Resize(LastRow - 2, 1).Formula = "=" & Chr(34) & "Carton " & Chr(34) & "&ROW(A1)" & "&" & Chr(34) & " of " & LastRow - 2 & Chr(34)
            .Resize(LastRow - 2, 1).Copy
            .PasteSpecial xlPasteValues
        End With
        Application.CutCopyMode = False
        .Range("A1").Select
    End With

End Sub

Hope this helps.

[Baboo]

Try this with your Sheet "Tiger"

Option Explicit

Sub AddRowsAndNumberNewRows()
    Dim LastRow As Long, RowNo As Long, RowsAdd As Long
    Dim NewRowNo As Long
    Dim wsTiger As Worksheet

    Set wsTiger = Sheets("Tiger")

    With wsTiger
        LastRow = .Range("H" & Rows.Count).End(xlUp).Row
        For RowNo = LastRow To 3 Step -1
            For RowsAdd = 1 To CInt(.Range("H" & RowNo - 1)) - 1
                .Rows(RowNo).Insert Shift:=xlDown
            Next
        Next
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        NewRowNo = WorksheetFunction.Max(Range("A2:A" & LastRow)) + 1
        For RowNo = 2 To LastRow
            If .Range("A" & RowNo) = "" Then
                .Range("A" & RowNo) = NewRowNo
                .Range("A" & RowNo).Font.ColorIndex = 1
                NewRowNo = NewRowNo + 1
            End If
        Next
        With .Range("J2")
            .Resize(LastRow - 2, 1).Formula = "=" & Chr(34) & "Carton " & Chr(34) & "&ROW(A1)" & "&" & Chr(34) & " of " & LastRow - 2 & Chr(34)
            .Resize(LastRow - 2, 1).Copy
            .PasteSpecial xlPasteValues
        End With
        Application.CutCopyMode = False
        .Range("A1").Select
    End With

End Sub

Hope this helps.

Marco:

the add J column for Carton 1 of 35 is wokring.
however, part 1 and Part 2 where i needed in the Monkey file is not working.

appreciated if you can re-look the monkey file
also, is there any way not to rename the sheet2 to" tiger"

thanks for your help!

[Marcol]

Post a sensible workbook.
Forget the Lion, the Tiger, and the Turkey Buzzard.
Put your problem in one workbook, simple names like "Sheet1", "Sheet2", etc will suffice.

A simple before and after example is usually enough.

[Baboo]

Post a sensible workbook.
Forget the Lion, the Tiger, and the Turkey Buzzard.
Put your problem in one workbook, simple names like "Sheet1", "Sheet2", etc will suffice.

A simple before and after example is usually enough.

Applogies Marcol, my DD has alot of stuff animals in the house. so thought it would be easy when recall. next time i will use flowers like, Lilly, Rose and Jasmine... LOL

okay, basically this is what i want:

- Relisting in [A column] in an increasement order from A2 (1,2,3) stop when it reaches [Total]. A2 was=1001, A3 was 1002

Next
- Insert 3 columns after [G column]
the new columns need to be named as follow:

new [H column] "Carton (Qty.)"
new [I column] "Case Number"
new [J column] "Carton Label #"

Next
- in [H column], =G2/12, =G3/12 - stop when it reaches the last # in [G colunm]

at last, i will execute the code that written by Marcol on the above.
in case, you want to see the sample file i am attaching [before] and [after] file.
thanks for all the help!

[Baboo]

@ Marcol
Can u help ??

[TMS]

@Marcol: Turkey Buzzard? Missed that one ;-)

[Marcol]

@ TMShucks
It's a workbook after "Aardvark" and before "Zebra", but it's on a different server.

[Marcol]

This is not how I would normally code this but as I can't fully understand what you finally want as a result. I have broken the code into several subs so that you can easily comment them out in the macro "Convert Sheet", or edit the individual subs.

The numbering you have asked for in "Line" seems to me, to be at odds with what you ask for in "Carton Label#".

Option Explicit

Sub ConvertSheet()
    Dim LastRow As Long
    Dim ws As Worksheet

    On Error GoTo ResetApplication
    Application.ScreenUpdating = False
    
    Set ws = Sheets("Sheet1")
    
    ' Call the routines
    LastRow = ws.Range("F" & Rows.Count).End(xlUp).Row
    AddColumns ws, LastRow
    RenumberLines ws, LastRow
    AddRowsAndNumberNewRows ws, LastRow + 1
    AddCartonLabels ws
    
    ws.Range("A1").Select
    
ResetApplication:
    Err.Clear
    On Error GoTo 0
    Application.ScreenUpdating = True
    Set ws = Nothing

End Sub

Sub AddColumns(ws As Worksheet, LastRow As Long)
    With ws
        .Columns("H:H").Insert Shift:=xlToRight
        .Range("H1") = "Carton Label#"

        .Columns("H:H").Insert Shift:=xlToRight
        .Range("H1") = "Case Number"

        .Columns("H:H").Insert Shift:=xlToRight
        .Range("H1") = "Carton (QTY.)"
        .Range("H2").Resize(LastRow, 1).Formula = "=G2/12"

        .Columns("H:J").AutoFit
    End With
End Sub

Sub RenumberLines(ws As Worksheet, LastRow As Long)
    Range("A2") = 1
    Range("A3") = 2
    Range("A2:A3").AutoFill Destination:=Range("A2:A" & LastRow), Type:=xlFillSeries
    With Range("A2:A" & LastRow).Font
        .ColorIndex = 3    'Red
        .Bold = True
    End With
End Sub

Sub AddRowsAndNumberNewRows(ws As Worksheet, LastRow As Long)
    Dim RowNo As Long, RowsAdd As Long, NewLineNo As Long

    With ws
        For RowNo = LastRow To 3 Step -1
            For RowsAdd = 1 To CInt(.Range("H" & RowNo - 1)) - 1
                .Rows(RowNo).Insert Shift:=xlDown
            Next
        Next
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        NewLineNo = WorksheetFunction.Max(Range("A2:A" & LastRow)) + 1
        For RowNo = 2 To LastRow
            If .Range("A" & RowNo) = "" Then
                .Range("A" & RowNo) = NewLineNo
                .Range("A" & RowNo).Font.ColorIndex = 1
                NewLineNo = NewLineNo + 1
            End If
        Next
    End With
End Sub

Sub AddCartonLabels(ws As Worksheet)
    Dim LastRow As Long
    
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    With ws.Range("J2")
        .Resize(LastRow - 2, 1).Formula = "=" & Chr(34) & "Carton " & Chr(34) & "&ROW(A1)" & "&" & Chr(34) & " of " & LastRow - 2 & Chr(34)
        .Resize(LastRow - 2, 1).Copy
        .PasteSpecial xlPasteValues
    End With
    Application.CutCopyMode = False
    ws.Columns("J:J").AutoFit
End Sub

"Sheet1" is a copy of your before sheet ("monkey"?), the code will convert "Sheet1"
To convert one of the sheets from your DDs' stuffed animals colection change ths line in the sub "ConvertSheet"

Set ws = Sheets("Sheet1")

e.g.

Set ws = Sheets("monkey")

Hope this helps

[EDIT]
If the line numbers are to be 1001, 1002, etc
Change these lines in Sub RenumberLines

    Range("A2") = 1
    Range("A3") = 2

To

    Range("A2") = 1001
    Range("A3") = 1002

[Baboo]

This is not how I would normally code this but as I can't fully understand what you finally want as a result. I have broken the code into several subs so that you can easily comment them out in the macro "Convert Sheet", or edit the individual subs.

The numbering you have asked for in "Line" seems to me, to be at odds with what you ask for in "Carton Label#".

Option Explicit

Sub ConvertSheet()
    Dim LastRow As Long
    Dim ws As Worksheet

    On Error GoTo ResetApplication
    Application.ScreenUpdating = False
    
    Set ws = Sheets("Sheet1")
    
    ' Call the routines
    LastRow = ws.Range("F" & Rows.Count).End(xlUp).Row
    AddColumns ws, LastRow
    RenumberLines ws, LastRow
    AddRowsAndNumberNewRows ws, LastRow + 1
    AddCartonLabels ws
    
    ws.Range("A1").Select
    
ResetApplication:
    Err.Clear
    On Error GoTo 0
    Application.ScreenUpdating = True
    Set ws = Nothing

End Sub

Sub AddColumns(ws As Worksheet, LastRow As Long)
    With ws
        .Columns("H:H").Insert Shift:=xlToRight
        .Range("H1") = "Carton Label#"

        .Columns("H:H").Insert Shift:=xlToRight
        .Range("H1") = "Case Number"

        .Columns("H:H").Insert Shift:=xlToRight
        .Range("H1") = "Carton (QTY.)"
        .Range("H2").Resize(LastRow, 1).Formula = "=G2/12"

        .Columns("H:J").AutoFit
    End With
End Sub

Sub RenumberLines(ws As Worksheet, LastRow As Long)
    Range("A2") = 1
    Range("A3") = 2
    Range("A2:A3").AutoFill Destination:=Range("A2:A" & LastRow), Type:=xlFillSeries
    With Range("A2:A" & LastRow).Font
        .ColorIndex = 3    'Red
        .Bold = True
    End With
End Sub

Sub AddRowsAndNumberNewRows(ws As Worksheet, LastRow As Long)
    Dim RowNo As Long, RowsAdd As Long, NewLineNo As Long

    With ws
        For RowNo = LastRow To 3 Step -1
            For RowsAdd = 1 To CInt(.Range("H" & RowNo - 1)) - 1
                .Rows(RowNo).Insert Shift:=xlDown
            Next
        Next
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        NewLineNo = WorksheetFunction.Max(Range("A2:A" & LastRow)) + 1
        For RowNo = 2 To LastRow
            If .Range("A" & RowNo) = "" Then
                .Range("A" & RowNo) = NewLineNo
                .Range("A" & RowNo).Font.ColorIndex = 1
                NewLineNo = NewLineNo + 1
            End If
        Next
    End With
End Sub

Sub AddCartonLabels(ws As Worksheet)
    Dim LastRow As Long
    
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    With ws.Range("J2")
        .Resize(LastRow - 2, 1).Formula = "=" & Chr(34) & "Carton " & Chr(34) & "&ROW(A1)" & "&" & Chr(34) & " of " & LastRow - 2 & Chr(34)
        .Resize(LastRow - 2, 1).Copy
        .PasteSpecial xlPasteValues
    End With
    Application.CutCopyMode = False
    ws.Columns("J:J").AutoFit
End Sub

"Sheet1" is a copy of your before sheet ("monkey"?), the code will convert "Sheet1"
To convert one of the sheets from your DDs' stuffed animals colection change ths line in the sub "ConvertSheet"

Set ws = Sheets("Sheet1")

e.g.

Set ws = Sheets("monkey")

Hope this helps

[EDIT]
If the line numbers are to be 1001, 1002, etc
Change these lines in Sub RenumberLines

    Range("A2") = 1
    Range("A3") = 2

To

    Range("A2") = 1001
    Range("A3") = 1002

@Marcol,
i wanted to take the time and thank you! the code works perfectly! you are amazing!!
thanks again for taking your time to help me! I'm truly grateful!