VBA to copy and insert a row below only if a certain criteria is met

feni1388

Board Regular
Joined
Feb 19, 2018
Messages
133
Office Version
  1. 2021
Platform
  1. Windows
Hello...

I have a list that when the cell in column U has "charge" in it, a row will be inserted below it, and column G will be changed to "Z001" and column J will be changed with the one from column R of the previous row (the total qty).
I found these lines of code in the internet.
With these lines, I can insert the row below and copy the previous row, but I don't know how to:
1. Paste it on the row that I just created.
2. Change column J with the value from column R of the previous row (the total qty).

Please help.....


Sub insertrow()

Dim i As Integer
Dim j As Integer

For i = 1 To 1000

j = InStr(1, Cells(i, 21), "charge", vbTextCompare)

If j = 1 Then
Cells(i + 1, 1).EntireRow.Insert
Cells(i, 1).EntireRow.Copy

Cells(i + 1, 7).Value = "Z001"


i = i + 2

Else
End If

Next i

End Sub

FPC test.xlsx
ABCDEFGHIJKLMNOPQRSTU
1123456789101112131415161718192021
2DateNo.Customer codeDateDelivery dateNoteItem no.Customer no.Warehouse codeQtyDelivery codeDelivery company codePICMemo to be printed 1Memo to be printed 2Order to warehouseFirst/end of lineTotal qtyNeed to chargecustomer's rowsAdditional charge
32024/4/160FPC010002024/4/162024/4/17GH93GY33142FPC018593No.GY331/No.5929№:4075886Attach delivery memo12Yes1charge
42024/4/160FPC010002024/4/162024/4/17GH73GY33265FPC01878No.GY332-769/No.FUP64-Q47/№:00839820-86Attach delivery memo112Yes3 
52024/4/160FPC010002024/4/162024/4/17GH53GY33262FPC01878No.GY332-769/No.FUP64-Q47/№:00839820-86Attach delivery memo012Yes3 
62024/4/160FPC010002024/4/162024/4/17GH98GY76965FPC01878No.GY332-769/No.FUP64-Q47/№:00839820-86Attach delivery memo212Yes3 
72024/4/160FPC010002024/4/162024/4/17GH53GX50551FPC01923No.GX505/No.ア5894№:839653Attach delivery memo12Yes2 
82024/4/160FPC010002024/4/162024/4/17GH73GX50551FPC01923No.GX505/No.ア5894№:839653Attach delivery memo22Yes2charge
92024/4/160FPC010002024/4/162024/4/18GH43ケ595643FPC01A88No.5956/No.1844604Attach delivery memo13Yes1 
102024/4/160FPC010002024/4/162024/4/17GH93GY65145FPC01A93No.GY651/No.5107168Attach delivery memo15Yes1 
112024/4/160FPC010002024/4/162024/4/17KZ16GY55461FPC01B021No.GY554/No.248979Attach delivery memo11Yes1charge
122024/4/160FPC010002024/4/162024/4/18GH23ケ569061FPC01B211No.5690/No.Attach delivery memo11Yes1charge
132024/4/160FPC010002024/4/162024/4/18BM93GY79361FPC01B361No.GY793/No.5468Attach delivery memo11Yes1charge
142024/4/160FPC010002024/4/162024/4/17GL48ケ567446FPC01B43No.5674/No.Attach delivery memo18Yes2 
152024/4/160FPC010002024/4/162024/4/17BM73ケ567442FPC01B43No.5674/No.Attach delivery memo28Yes2 
162024/4/160FPC010002024/4/162024/4/18BM73GY79162FPC01B55No.GY791/No.5467Attach delivery memo13Yes2 
172024/4/160FPC010002024/4/162024/4/18BM93GY79161FPC01B55No.GY791/No.5467Attach delivery memo23Yes2 
182024/4/160FPC010002024/4/162024/4/18BM73GY79262FPC01B87No.GY792/No.5469Attach delivery memo12Yes1charge
192024/4/160FPC010002024/4/162024/4/17JR13ケ591442FPC01C013No.5914/No.Attach delivery memo12Yes1charge
Sheet1
Cell Formulas
RangeFormula
Q3:Q19Q3=IF(K3="","",IF(K3<>K2,1,IF(K3<>K4,2,0)))
R3:R19R3=IF(K3="","",SUMIF(K:K,K3,J:J))
T3:T19T3=IF(K3="","",COUNTIF(K:K,K3))
U3:U19U3=IF(AND(R3<3,S3="yes",T3=1),"charge",IF(AND(R3<3,S3="Yes",T3>1,Q3=2),"charge",""))
Cells with Conditional Formatting
CellConditionCell FormatStop If True
N3:N19Expression=LENB(N3)>32textNO
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Additional note:
I was able to modify it like this and I got the result that I wanted, but I don't know why there're 2 rows that have "charge" in this but was skipped.


Dim i As Integer
Dim j As Integer

For i = 1 To 1000

j = InStr(1, Cells(i, 21), "charge", vbTextCompare)

If j = 1 Then
Cells(i, 1).EntireRow.Copy
Cells(i + 1, 1).EntireRow.Insert
Application.CutCopyMode = False



Cells(i + 1, 7).Value = "Z001"
Cells(i + 1, 10).Value = Cells(i, 18)

i = i + 2

Else
End If

Next i
 
Upvote 0
I have found where the problem was, so I marked it as solved.
 
Upvote 0

Forum statistics

Threads
1,224,819
Messages
6,181,153
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top