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

F

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

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
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

F
  • Solved
Put a mark on rows that have the same 10 digits but different last one digit
Replies
2
Views
187
feni1388
F
M
  • Question Question
Copied sheet code to new file and lost some functionality....not sure how/why
Replies
5
Views
90
MeaclH
M
P
  • Question Question
Having trouble with forumla to use Countifs for only specific names listed in a column
Replies
1
Views
607
Paradigmgaming911
P
R
  • Question Question
Golf scoring game
Replies
4
Views
558
Rock5150
R
E
  • Solved
Macro stops working before end sub with no prompt
2 3
Replies
21
Views
2K
_eNVy_
E

Forum statistics

Threads
1,223,884
Messages
6,175,177
Members
452,615
Latest member
bogeys2birdies

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