VBA Copy & Paste Row While Replacing 2 Cell Values

[wisco]

I'm new to vba and I'm trying to copy a row (if it features the value "2020" in column G" and insert it right below the copied row). And then I need to replace the "2020" value with "2021" in the new created row. I also need to replace the value in column A with the value from the copied row multiplied by a number from a different cell. These are the parts I'm struggling with.

I have up to the new created and copied row.

Sub Test()
Dim iLastRow As Long
Dim i As Long

iLastRow = Cells(Rows.Count, "G").End(xlUp).Row
For i = iLastRow To 1 Step -1
If Cells(i, "G").Value = "2020" Then
Rows(i).Copy
Rows(i + 1).Insert

End If
Next i
End Sub


Thanks.

 

[bugmonsta]

Taking your code I have quickly added a solution which may be of some use, I'm sure one of the experts will have a better solution that works faster but in the meantime....

The msgboxes are to for testing only to show what has been copied and pasted, remove these once you have tested

Sub Test()
 Dim iLastRow As Long
 Dim i As Long
 mb = Cells(1, "h").value           'set the cell you want to multiply by
    iLastRow = Cells(Rows.Count, "G").End(xlUp).Row
    For i = iLastRow To 1 Step -1
    
 If Cells(i, "G").value = "2020" Then
 Rows(i).Copy
 Rows(i + 1).Insert
 j = i + 1 ' set j as your original row +1
        Cells(j, "G").value = "2021"   
        newfig = Range("a" & j) * mb 'multiply by H1 as set above
        Cells(j, "A").value = newfig 'set newvalue into new row, cell A

MsgBox "Copied from row " & i & " to " & j
MsgBox "new figure in A should be " & newfig & " as it was " & Cells(i, "A").value & " multiplied by " & mb 
 End If
 Next i
 End Sub

This is the first code I created as I was putting the multiply value in a row below the rows I was running this against and of course the cell kept moving with my test inserts and deletes - so I designed it to ask for the value.

Sub Testwithprompt()
 Dim iLastRow As Long
 Dim i As Long
        answer = Application.InputBox(Prompt:="Please enter a figure", Type:=1)
    iLastRow = Cells(Rows.Count, "G").End(xlUp).Row
    For i = iLastRow To 1 Step -1
    
 If Cells(i, "G").value = "2020" Then
 Rows(i).Copy
 Rows(i + 1).Insert
 j = i + 1
        Cells(j, "G").value = "2021"
        newfig = Range("a" & j) * answer
        Cells(j, "A").value = newfig

MsgBox "Copied from row " & i & " to " & j
MsgBox "new figure in A should be " & newfig & " as it was " & Cells(i, "A").value & " multiplied by " & answer
 
 End If
 Next i
 End Sub

 

[wisco]

Awesome, thanks. Works great.

I now need to multiply the same value I did for column A, for columns B through column F, The value in column A doesn't need to change. I tried to fix it, but I've ran into some issues. Any suggestions?

This is what I have so far:

Sub Testing()
Dim iLastRow As Long
Dim i As Long
mb = Cells(2, "s").Value 'set the cell you want to multiply by
iLastRow = Cells(Rows.Count, "G").End(xlUp).Row
For i = iLastRow To 1 Step -1

If Cells(i, "G").Value = "2020" Then
Rows(i).Copy
Rows(i + 1).Insert
j = i + 1 ' set j as your original row +1
Cells(j, "G").Value = "2021"
newfig = Range("b" & j) * mb 'multiply by H1 as set above
Cells(j, "b").Value = newfig 'set newvalue into new row, cell A


End If
Next i
End Sub

This code works, but only changes the values in Column B. I'm trying to get it to work for column B through column F.

Thanks again.

 

[bugmonsta]

Hello, happy we are getting you on the right path..... woohoo!

So if you want to multiply B to F by different figure then my dirty way is to set each one

 Sub Testing2()
 Dim iLastRow As Long
 Dim i As Long
 mb = Cells(2, "s").value
[COLOR="#FF0000"] mc = Cells(2, "t").value ' T number to multiply by
 md = Cells(2, "u").value ' U number to multiply by[/COLOR]
 
 iLastRow = Cells(Rows.Count, "G").End(xlUp).Row
 For i = iLastRow To 1 Step -1

 If Cells(i, "G").value = "2020" Then
 Rows(i).Copy
 Rows(i + 1).Insert
 j = i + 1 ' set j as your original row +1
 Cells(j, "G").value = "2021"
 newfigB = Range("b" & j) * mb '<-- changed name to newfigB so we know its for column B, simple but its a handy reminder
[COLOR="#FF0000"] newfigC = Range("C" & j) * mc ' multuply by T2
 newfigd = Range("d" & j) * md ' etc[/COLOR]
 
 Cells(j, "b").value = newfigB
[COLOR="#FF0000"] Cells(j, "c").value = newfigC 'set newvalue into new row, cell B
 Cells(j, "d").value = newfigd[/COLOR]
 
 End If
 Next i
 End Sub

Whilst typing this up, I worked out how to get cells B to F multiplied with one figure in the code.... untested as I am not at my machine but will get back to it today to fully test if needed.

Sub testing3()
'----not tested as I'm not at my machine with Excel!
 Dim iLastRow As Long
 Dim i As Long
 Dim c As Range
 
 mb = Cells(2, "s").value
 
 iLastRow = Cells(Rows.Count, "G").End(xlUp).Row
 For i = iLastRow To 1 Step -1

 If Cells(i, "G").value = "2020" Then
 Rows(i).Copy
 Rows(i + 1).Insert
 j = i + 1 ' set j as your original row +1
 Cells(j, "G").value = "2021"
'-------------New section to multiple B to F in the new row by the same figure
    For Each c In ActiveSheet.Range("b" & j, "f" & j)
        c.value = c.value * Cells.Range("s2").value
    Next c

 End If
 Next i
 End Sub

 

[wisco]

After adjusting them to what I needed, both worked very well.

Thank you very much.

Now if I wanted to split this into two categories, based on the value in a column, what would i need to do? So the half of the columns have the value "Table" in it and the other half have "Chairs." So if the value has "table" in it, then the new inserted rows (from columns b to f) would all be multiplied by a specific number. And if it was "chairs", the new rows would be multiplied by a different number.

I tried adding another If condition, but for some reason the multiplication wouldn't work. I got the new rows to be added, but after all afternoon, the struggle is still the multiplication.

Any help is greatly appreciated, thanks again!

 

[bugmonsta]

Hello again,

This should work, using an AND, with an ELSEif

Also note I have added the top line 'Option Compare Text'; this stops the he searching for text being case sensitive. I have changed Table to look at r2 figure - but as you have been working this out as you go I'm sure you will change it to your needs

Option Compare Text
Sub table_chair()

'----not tested as I'm not at my machine with Excel!
Application.ScreenUpdating = False

 Dim iLastRow As Long
 Dim i As Long
 Dim c As Range
 
 mb = Cells(2, "s").value
 
 iLastRow = Cells(Rows.Count, "G").End(xlUp).Row
 For i = iLastRow To 1 Step -1
 
 If Cells(i, "G").value = "2020" And (Cells(i, "H").value = ("chair")) Then
 Rows(i).Copy
 Rows(i + 1).Insert
 j = i + 1 ' set j as your original row +1
 Cells(j, "G").value = "2021"
'-------------New section to multiple B to F in the new row by the same figure
    For Each c In ActiveSheet.Range("b" & j, "f" & j)
        c.value = c.value * Cells.Range("s2").value
    Next c

 '-----------------------TABLE STUFF - Exactly the same but different multiplying figure
 ElseIf Cells(i, "G").value = "2020" And Cells(i, "h").value = "Table" Then
 Rows(i).Copy
 Rows(i + 1).Insert
 j = i + 1 ' set j as your original row +1
 Cells(j, "G").value = "2021"
'-------------New section to multiple B to F in the new row by the same figure
    For Each c In ActiveSheet.Range("b" & j, "f" & j)
        c.value = c.value * Cells.Range("r2").value
    Next c

 End If
 Next i
 
Application.CutCopyMode = False
Range("A1").Select
Application.ScreenUpdating = True
 End Sub

 

[wisco]

This is great, works like a charm.

Thank you very much.