Yeah, you were right it was the next part of my script.
How would I go about cutting and pasting the data in column I of the attached spreadsheet to a certain number of rows below where the data is now?
So the numbers in column I would need to be pasted the number of rows shown in column N. For example for I13 the number 2 would need to move down 2 rows in the same column, same for I10 move down to I12 and so on.
Here is my entire script, everything works perfectly just need that last step to complete it.
Code:
Sub AddingRows()
Dim LR As Long
Dim n As Integer
Dim temp As Long
Dim rng As Range, ar As Range
Dim nr As Range
Dim mr As Range
'Column E
'PO Number
Sheets("Data").Select
Columns("B:H").Select
Selection.Copy
Sheets("WinShuttleUpload (2)").Select
Columns("C:C").Select
ActiveSheet.Paste
Range("D2").Select
LR = ActiveSheet.UsedRange.Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Range("M2").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-10],RC[-10])"
Range("M2").AutoFill Destination:=Range("M2:M" & LR)
Range("M:M").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-11]=R[-1]C[-11],R[-1],IF(RC[-1]>0,RC[-1]+1))"
Range("N2").AutoFill Destination:=Range("N2:N" & LR)
Range("N:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
LR = ActiveSheet.Range("C" & Rows.count).End(xlUp).Row
While LR > 0
If ActiveSheet.Range("C" & LR).Value <> ActiveSheet.Range("C" & LR + 1) Then
Dim NewRows As Long: NewRows = ActiveSheet.Range("N" & LR).Value
Dim InsertIndex As Long: InsertIndex = 1
While InsertIndex <= NewRows
ActiveSheet.Range("N" & LR + 1).EntireRow.Insert
InsertIndex = InsertIndex + 1
Wend
End If
LR = LR - 1
Wend
Range("G3:H3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
On Error Resume Next
Set rng = Columns(3).SpecialCells(xlBlanks)
For Each ar In rng.Areas
ar(0).Copy ar
Next
Set rng = Columns(13).SpecialCells(xlBlanks)
For Each mr In rng.Areas
mr(0).Copy mr
Next
Set rng = Columns(14).SpecialCells(xlBlanks)
For Each nr In rng.Areas
nr(0).Copy nr
Next
On Error GoTo 0
End Sub