VBA to Insert Blank Row Based on Two Variables

[nirvehex]

Hi,

I'm trying to create a VBA code to do the following:

I have one tab called "Recommendations" and the two variables that inserting a blank row depends on are found in columns CH and CV.

Essentially on the tab called "Recommendations", I would like to look at each row starting with row 3 to the last row with data in it (control + down).

I'm trying to have the code look at the two columns, CH and CV and if it finds that CH = "Yes" and CV = "Third Party" then look at column E on "Recommendations" to identify it's code (6 digit number). Then the code should go over to another tab called "Raw" and find that same 6 digit number in column M. In this column M on the "raw" sheet the code may be repeated twice, three, or even several times, but they are always grouped together.

For example you might see something like this in column M on the "Raw" tab:



1234581


1234581


1234581


1305969


1306000


1474942


1474942


1234604


1234604


1234604


1234604




What I'm trying to get the code to do is go down to the last like 6 digit code and insert a blank row underneath it if and only if it's respective CH and CV columns on the "Recommendations" tab = "Yes" & "Third Party".

So to recap (and I hope I'm making some kind of sense here):

On recommendations tab row 3 to end, if and only if CH= "Yes" and CV = "Third Party", find code in column E on recommendations and match it to same code in column M on "Raw" tab. Then go down to last row with same code and insert blank row underneath it.

1) Identify IDs on recommendation tab in column E where column CH = "Yes" & CV = "Third Party".


2) Find identified IDS on raw tab in column M


3) Go down to last like ID in grouping and insert blank row below.


4) Repeat for all IDS that met that qualification.





Any ideas? I am so lost...

Thanks!

Note: Cross posted @ http://www.mrexcel.com/forum/excel-questions/892554-visual-basic-applications-insert-blank-row-based-two-variables.html

[p45cal]

continuing from where davesexcel left off at your cross post:
Sub DOit()
Dim sh As Worksheet
Dim LstRw As Long
Dim Rng As Range, c As Range
Dim y As String, T As String, x As Range, ofset As Long

y = "Yes"
T = "Third Party"
Set sh = Sheets("Recommendations")
With sh
LstRw = .Cells(.Rows.Count, "CH").End(xlUp).Row
Set Rng = .Range("CH2:CH" & LstRw)
For Each c In Rng.Cells
If c = y And c.Offset(0, 14) = T Then
'MsgBox c.Address 'this is where you want to do something
Set x = Sheets("Raw").Range("M:M").Find(what:=c.Offset(, -81).Value, LookAt:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
If Not x Is Nothing Then
ofset = 1
Do Until x.Offset(ofset) <> c.Offset(, -81).Value
ofset = ofset + 1
Loop
x.Offset(ofset).EntireRow.Insert
End If
End If
Next c
End With
End SubYou might tell mrExcel that you've cross posted here too; saves anyone duplicating effort.

[snb]

Sub M_snb()
sn=filter([transpose(if(recommendations!CH1:CH1000&recommendations!CV1:CV1000="YesThird Party",recommendations!E1:E1000,"~"))],"~",0)

for j=0 to ubound(sn)
sheets("Raw").cells(1,26)=sn(j)
sheets("Raw").rows([max((Raw!M1:M1000=Raw!Z1)*row(1:1000))]).insert
next
End Sub

[p45cal]

"YesThirdparty" should be "YesThird Party"
],"~") should be ], "~", 0)
.cells(1,16) should be .cells(1,26)

[snb]

@p45cal

Thank you for testing ! :)
I amended my post.

[nirvehex]

p45cal that worked beautifully! Thank you! I was hoping to add a few more conditions to this code. Was wondering if you can assist a bit further.

Essentially, I want to keep this code and add these conditions:

1) Identify IDs on recommendation tab in column E where column CH = "Yes" & CV = "Home".


2) Find identified IDS on raw tab in column M


3) Go down to last like ID in grouping and insert 2 blank rows below.


4) Repeat for all IDS that met that qualification.

Is it easy to add that into the code you already created? :)

Thanks again!

[p45cal]

oops, forgot one:
row(1:1000))]).Insert
should be:
row(1:1000))] + 1).Insert

[p45cal]

Sub DOit()
Dim sh As Worksheet
Dim LstRw As Long
Dim Rng As Range, c As Range
Dim y As String, T As String, H As String, x As Range, ofset As Long

y = "Yes"
T = "Third Party"
H = "Home"
Set sh = Sheets("Recommendations")
With sh
LstRw = .Cells(.Rows.Count, "CH").End(xlUp).Row
Set Rng = .Range("CH2:CH" & LstRw)
For Each c In Rng.Cells
If c = y And (c.Offset(0, 14) = T Or c.Offset(0, 14) = H) Then
'MsgBox c.Address 'this is where you want to do something
Set x = Sheets("Raw").Range("M:M").Find(what:=c.Offset(, -81).Value, LookAt:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
If Not x Is Nothing Then
ofset = 1
Do Until x.Offset(ofset) <> c.Offset(, -81).Value
ofset = ofset + 1
Loop
x.Offset(ofset).EntireRow.Insert
If c.Offset(0, 14) = H Then x.Offset(ofset).EntireRow.Insert
End If
End If
Next c
End With
End Sub

[nirvehex]

Thanks p45cal! This worked perfectly...again!