Solved Need Macro to insert and copy lines but change two values

Tags:
macros
May 27, 2014 at 07:48:03
Specs: Windows 7
Hello,

Wondering if someone could help me modify a macro to include a couple extra steps.

I found code on this website that:
1. Inserts rows based on the value in column E (# of rows based on column E minus 1)
2. Copy and pastes the exact same data on the rows inserted

I need to modify my macro to change two column values instead of pasting the exact data as is. Below is an example of my current data and how I need it to look afterwards. I also included the code I found on here that inserts and copies the rows.

Currently

     A       B      C           D                E
1    Cust    2      1/5/2014    Promo Descx      4
2    Cust    23     6/1/2014    Promo Descy      2

After

     A        B     C           D                E
1    Cust     2     1/5/2014    Promo Descx      4
2    Cust     3     1/12/2014   Promo Descx      4
3    Cust     4     1/19/2014   Promo Descx      4
4    Cust     5     1/26/2014   Promo Descx      4
5    Cust     23    6/1/2014    Promo Descy      2
6    Cust     24    6/8/2014    Promo Descy      2

After the code inserts the rows, I need it to copy everything as is except column B (needs to be value +1) and column C (needs to be date +7).

The code I'm using to insert rows and copy/paste is below (my data starts on row 2): 

 Sub Insert_By_E_Value()
'Determine last Row with data in Column E
  lastRw = Cells(Rows.Count, "E").End(xlUp).Row
'Loop through rows in reverse order
    For rw = lastRw To 2 Step -1
'If Column E > 1, insert Rows
     If Cells(rw, "E") > 1 Then
       For newRw = 1 To Cells(rw, "E") - 1
         Cells(rw, "E").EntireRow.Copy
         Cells(rw, "E").EntireRow.Insert shift:=xlDown
       Next
     End If
    Next
End Sub

Thanks in advance for any help!

message edited by mango42


See More: Need Macro to insert and copy lines but change two values

Report •

#1
May 27, 2014 at 09:41:16
✔ Best Answer
Try this...

 Sub InsertAdd_By_E_Value()
'Determine last Row with data in Column E
  lastRw = Cells(Rows.Count, "E").End(xlUp).Row
'Loop through rows in reverse order
    For rw = lastRw To 2 Step -1
'If Column E > 1, insert Rows, add Values
     If Cells(rw, "E") > 1 Then
'Set variable for addition calculation
      addCnt = Cells(rw, "E") - 1
       For newRw = 1 To Cells(rw, "E") - 1
'Insert rows
         Cells(rw, "E").EntireRow.Copy
         Cells(rw, "E").EntireRow.Insert shift:=xlDown
'Add Value to Columns B and C in new Row
          Cells(rw + 1, "B") = Cells(rw + 1, "B") + addCnt
          Cells(rw + 1, "C") = Cells(rw + 1, "C") + (addCnt * 7)
'Decrement value to be added
           addCnt = addCnt - 1
       Next
     End If
    Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
May 27, 2014 at 11:55:47
This works amazing, thank you so much for the quick response. Really appreciate it, will save me tons of time!

Report •
Start a discussion
Related Solutions
See More ↓


Ask Question