VBA copy insert data depending on value

plastakis

New Member
Joined
Apr 10, 2019
Messages
23
I got a very big challenge that I tried to find on google but couldn’t find. My problem is that you need to insert rows below the main value according to the dependency. I have got such vba is it possible adapt to my needs.

Sub InsertBlankRowsBasedOnCellValue()

Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long

Col = "B"
StartRow = 6
BlankRows = 1

LastRow = Cells(Rows.Count, Col).End(xlUp).Row

Application.ScreenUpdating = False

With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) = "insert" Then
.Cells(R, Col).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
Application.ScreenUpdating = True

End Sub

I attached my project process how it look like.
 

Attachments

  • expectation.PNG
    expectation.PNG
    41.8 KB · Views: 20
You're welcome & thanks for the feedback.
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
I have one more question is it possible to make that original part will be first (upper row), and it components in lower rows. Right now the code make opposite.
 
Upvote 0
Do you mean that you now want to do the exact opposite of what you asked for?
 
Upvote 0
Ok i send you two print screens, one of them is my basic part number file name - 1 and second one after i use vba and insert parts components. The main problem, that first goes component and just after it part number. My question was is it possible to make that part number will be in upper cell and components in lower.
 

Attachments

  • 1.PNG
    1.PNG
    41.5 KB · Views: 5
  • 2.PNG
    2.PNG
    30.3 KB · Views: 5
Upvote 0
Posting an image of what you get is totally pointless, as I wrote the code & therefore know what it does.
Try posting an image of what you want.
 
Upvote 0
[
Sub plastakis()
Dim Cl As Range, Fnd As Range

For Each Cl In Worksheets("DEF Dalys Quantum").Range("C2", Worksheets("DEF Dalys Quantum").Range("d" & Rows.Count).End(xlUp))
Set Fnd = Worksheets("Sujungtas").Range("J:J").Find(Cl.Value, , , xlWhole, xlByRows, xlNext, , , False)
If Not Fnd Is Nothing Then
Fnd.EntireRow.Insert
Fnd.Offset(-1).Resize(, 8).Value = Cl.Resize(, 8).Value
End If
Next Cl
End Sub

]

I used your code which collect part number components from sheet "Def Dalys Quantum" and place them by part number name in sheet "Sujungtas". Everything working very well. But i have problem as I show in print screens. It place in upper cell components than part number in Sujungtas sheet. So i have such result.
Component which belongs to part number Nb. 1
Component which belongs to part number Nb. 1
Component which belongs to part number Nb. 1
Part number Nb. 1

I would like that code give me such result:
Part number Nb. 1
Component which belongs to part number Nb. 1
Component which belongs to part number Nb. 1
Component which belongs to part number Nb. 1

I tried to change Offset, but it haven't change as i needed.
 
Upvote 0
I'm sorry but I haven't got a clue what you are saying.
 
Upvote 0
The code collect data from one sheet to another. But collected data it place like this.
Like example my part number list are (A2, A3, A4 are cell location).
A2, xxxx Part number
A3, yyyy Part number
A4, zzzz Part number

The component list are:

Component code, Part number code.

1 , xxxx
2 ,xxxx

I got result like this

A2, 1, xxxx
A3, 2, xxxx
A4, xxxx Part number
A5, yyyy Part number
A6, zzzz Part number

is it possible to make in higher cell i got Part number
and under it I get component part number.

A2, xxxx Part number
A3, 1, xxxx
A4, 2, xxxx
A5, yyyy Part number
A6, zzzz Part number

,
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

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