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

F

feni1388

Board Regular
Joined
Feb 19, 2018
Messages
61
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

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
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
You must log in or register to reply here.

Similar threads

P
  • Question
Having trouble with forumla to use Countifs for only specific names listed in a column
Replies
1
Views
449
Paradigmgaming911
P
E
  • Solved
Macro stops working before end sub with no prompt
2 3
Replies
21
Views
1K
_eNVy_
E
C
  • Solved
Referencing accrued leave value for last last months last working day
Replies
5
Views
333
Peter_SSs
Peter_SSs
B
  • Solved
VBA that adds a new row, with data from the previous row, if certain criterias are met
2
Replies
16
Views
2K
Legacy 143009
L
G
  • Question
Copy Range of Cells based on Criteria, Paste it on rows below it, Do This Until All conditions are met, Then Delete All Copied Rows
Replies
0
Views
229
glaccounting
G

Forum statistics

Threads
1,215,200
Messages
6,123,612
Members
449,109
Latest member
Sebas8956

Share this page

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