Modify VBA to suit

[Papi]

Below is code from a Microsoft site that creates new rows each time it sees a number eg. if the number is 12 it will generate an additional 11 rows. Everything works great but I need to add the number 1 to each cell in column E when it creates each new row. If the number is 1 it will populate to 2 and then to 3 etc. How can this be modified to accomplish this?

Public Sub InsBelow()
Dim lngStartRow As Long
Dim lngEndRow As Long
Dim m As Integer
Dim n As Long
With ActiveSheet
lngStartRow = Range("F" & CStr(Application.Rows.Count)).End(xlUp).Row
lngEndRow = 1
For n = lngStartRow To lngEndRow Step -1
If IsNumeric(Range("F" & CStr(n)).Value) And Range("F" & CStr(n)).Value <> "" Then
    Rows(n + 1).Resize(Range("F" & n).Value - 1).Insert
     Rows(n).Resize(Range("F" & n).Value).FillDown
        End If
    Next n
End With
End Sub

 

[Rick Rothstein]

See if the macro does what you want...

Sub ExpandData()
  Dim R As Long, C As Long, X As Long, Repeat As Long, Index As Long, DataIn As Variant, DataOut As Variant
  DataIn = Range("A1:G" & Cells(Rows.Count, "A").End(xlUp).Row)
  ReDim DataOut(1 To 1 + WorksheetFunction.Sum(Columns("F")), 1 To UBound(DataIn, 2))
  Index = 1
  For X = 1 To UBound(DataIn, 2)
    DataOut(Index, X) = DataIn(1, X)
  Next
  For R = 2 To UBound(DataIn)
    Repeat = DataIn(R, 5)
    For X = 1 To DataIn(R, 6)
      Index = Index + 1
      For C = 1 To UBound(DataIn, 2)
        If C = 5 Then
          DataOut(Index, C) = Repeat + X - 1
        ElseIf C = 6 Then
          DataOut(Index, C) = DataIn(R, 6)
        Else
          DataOut(Index, C) = DataIn(R, C)
        End If
      Next
    Next
  Next
  Cells(Rows.Count, "A").End(xlUp).Offset(4).Resize(UBound(DataOut), UBound(DataOut, 2)) = DataOut
End Sub

 

[Joe4]

There may be other ways of doing it, but I used column B (part number) to look for changes in groups, and added a little loop at the end to go through column E and renumber.

See if this works for you:

Public Sub InsBelow()


    Dim lngStartRow As Long
    Dim lngEndRow As Long
    Dim m As Integer
    Dim n As Long


    Application.ScreenUpdating = False


    With ActiveSheet
        lngStartRow = Range("F" & CStr(Application.Rows.Count)).End(xlUp).Row
        lngEndRow = 1
        
        For n = lngStartRow To lngEndRow Step -1
            If IsNumeric(Range("F" & CStr(n)).Value) And Range("F" & CStr(n)).Value <> "" Then
                Rows(n + 1).Resize(Range("F" & n).Value - 1).Insert
                Rows(n).Resize(Range("F" & n).Value).FillDown
            End If
        Next n
        
        For m = 3 To Cells(Rows.Count, "E").End(xlUp).Row
            If Cells(m, "B") = Cells(m - 1, "B") Then Cells(m, "E") = Cells(m - 1, "E") + 1
        Next m
                    
    End With
    
    Application.ScreenUpdating = True


End Sub

Edit: Didn't see Rick's reply (didn't see there was a page 2). That seems to work well also.

 

[Papi]

Thanks very much gentlemen. I cannot imagine how much time is saved.

 

[Papi]

Looking back at the original code, what do I need to change to have it look also at cells with 1 and create one additional row and if possible to look at rows with Zero and leave that row alone then go up to complete the rest.

Dim lngStartRow As Long
Dim lngEndRow As Long
Dim m As Integer
Dim n As Long
With ActiveSheet
lngStartRow = Range("F" & CStr(Application.Rows.Count)).End(xlUp).Row
lngEndRow = 1
For n = lngStartRow To lngEndRow Step -1
If IsNumeric(Range("F" & CStr(n)).Value) And Range("F" & CStr(n)).Value <> "" Then
    Rows(n + 1).Resize(Range("F" & n).Value - 1).Insert
     Rows(n).Resize(Range("F" & n).Value).FillDown
        End If
    Next n
End With

 

[Joe4]

Looking back at the original code, what do I need to change to have it look also at cells with 1 and create one additional row and if possible to look at rows with Zero and leave that row alone then go up to complete the rest.

Would you mind posting another before & after picture of an example, like you did back in post #10?

 

[Papi]

Would you mind posting another before & after picture of an example, like you did back in post #10?

Thanks Joe. The short list is the start and it identifies how many rows are needed. The long list are those that are to be generated eg. if it says 3 rows then the original remains and adds three rows or if it says 1 row then the original remains and adds 1 row.

PO Register.xlsm
	A	B	C	D	E	F
1	PurchaseOrder	PartNo	Cost	Date	Period	RequireRows
2	PO23456	16402-2	18.53	06/02/14	1	3
3	PO23456	5H1626	0.53	06/03/14	2	1
4	PO23456	7Z8025	2.65	06/04/14	7	3
5	PO23456	1045	12.02	06/04/14	1	1
6	PurchaseOrder	PartNo	Cost	Date	Period	RequireRows
7	PO23456	16402-2(Original)	18.53	06/02/14	1	3
8	PO23456	16402-2Copy1)	18.53	06/02/14	1	3
9	PO23456	16402-2Copy2)	18.53	06/02/14	1	3
10	PO23456	16402-2Copy3)	18.53	06/02/14	1	3
11	PO23456	5H1626(Original)	0.53	06/03/14	2	1
12	PO23456	5H1626(Copy1)	0.53	06/03/14	2	1
13	PO23456	7Z8025(Original)	2.65	06/04/14	7	3
14	PO23456	7Z8025(Copy1)	2.65	06/04/14	7	3
15	PO23456	7Z8025(Copy2)	2.65	06/04/14	7	3
16	PO23456	7Z8025(Copy3)	2.65	06/04/14	7	3
17	PO23456	1045(Original)	12.02	06/04/14	1	1
18	PO23456	1045(Copy1)	12.02	06/04/14	2	1
Register

 

[Rick Rothstein]

Two questions for clarification...

1) Originally, you wanted the numbers in the Period column to increment in the newly produced table, but now you show the number remaining the same on all the repeated rows... which do you want now?

2) Your sample shows "(Original)" and "(Copy #)" in each repeated copy in the Part No. column... do you actually want that text in that column or did you include that text for descriptive purposes only?

 

[Papi]

Two questions for clarification...

1) Originally, you wanted the numbers in the Period column to increment in the newly produced table, but now you show the number remaining the same on all the repeated rows... which do you want now?

2) Your sample shows "(Original)" and "(Copy #)" in each repeated copy in the Part No. column... do you actually want that text in that column or did you include that text for descriptive purposes only?

Hello Rick. The the first request used a macro that was working in another workbook and I needed to expand on that one for another workbook. Now I am needing to go back to the first workbook and modify that workbook. Should I have started a new thread for my final request? I was not sure what to do here.

Original and Copy# are intended to identify that Original is the first row and the Copies are the new rows. The text can remain as I will adjust when needed.

 

[Rick Rothstein]

Hello Rick. The the first request used a macro that was working in another workbook and I needed to expand on that one for another workbook. Now I am needing to go back to the first workbook and modify that workbook. Should I have started a new thread for my final request? I was not sure what to do here.

Original and Copy# are intended to identify that Original is the first row and the Copies are the new rows.

No, not necessarily as the two questions seem quite related, but different enough to make your intent not entirely clear. What are the answers to my two questions... once we know exactly what you want outputted, then we can design the code to do it.

 

[Papi]

Apologies for the confusion. In the original workbook I removed rows that were blank or the formula returned a value less than 2 and returned them after the macro ran. What I would like to do is have the value of column F create x number of rows below it eg. if it returns a 1 then copy one row identical below it and if it returns any other value to copy that number of rows eg 4 would have the first (original) and 4 of the same (Copies 1 to 4). I was hoping to leave those with blank cells, zero or nothing to remain in the workbook and ignore them. There are other formulas that will automatically copy down if the entire row is copied.