Conditional Search Copy Entire Row to next row on match

[equalizer]

First time VBA user using Excel 2010 part of Office Pro 2010.
I need to search for data in col 2 and if it matches then copy that row to row below.
Search terms are "A" OR "D"

Before


Num

Reg

Com 1

Com 2











2

A

yes

no





3

B

no

no





4

D

yes

yes





5

C

no

no




After


Num

Reg

Com 1

Com 2











2

A

yes

no





2

A

yes

no





3

B

no

no





4

D

yes

yes





4

D

yes

yes





5

C

no

no




Used code from other questions and mashed this up.
Problem is with this code I need to new macro for each search term
because there is no OR statement allowed in Cell.Find( What ..) ?
Must be better way using some functions that I'm not familiar with.

[CODE][Sub Search_Value_Copy_Row_()

OR_Count = Application.WorksheetFunction.CountIf(Range("A1:Z100"), "A")
Do Until OR_Count = 0
Cells.Find(What:="A", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

ActiveCell.EntireRow.Copy
ActiveCell.EntireRow.Insert

ActiveCell.Offset(1, 0).Select

OR_Count = OR_Count - 1
Loop
End Sub
/CODE]

[mperrah]

try this

Sub vbax52593()
' ask for letter match then duplicate row and shift down
Dim x, lr
Dim fStrng

lr = Cells(Rows.Count, 1).End(xlUp).Row
fStrng = InputBox("What do you want to search for and copy down?")
For x = 2 To lr
If Cells(x, 2).Value = fStrng Then
'MsgBox "we found a match!", vbOKOnly
Range("A" & x & ":D" & x).Copy
Range("A" & x & ":D" & x).Offset(1).Insert shift:=xlDown
Application.CutCopyMode = False
x = x + 1
lr = lr + 1
Else
'MsgBox ("No match at " & x)
End If
Next x
End Sub

-mark

[equalizer]

Thank you so much Mark, I will give it a try.
Can you explain statement lr= Cells(Rows.Count, 1).End(xlUp).Row ?


Most examples I have seen start counting from bottom so they don't mess up the row count as I have done below.
I like how you came up with adding both counters to counter this problem.
I came up with this last night. I think I will end up merging the two versions.



Sub COPY_CURRENT_ROW_CASE()
Application.ScreenUpdating = False
For MY_ROWS = (ActiveSheet.UsedRange.Rows.Count + 1) To 1 Step -1
x = Range("C" & MY_ROWS).Value

Select Case x
Case "A", "D"
Rows(MY_ROWS).Copy
Rows(MY_ROWS + 1).Insert

Case Else
End Select

Next MY_ROWS
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

[mperrah]

Sure, by the way welcome to the Forum :)


lr = Cells(Rows.Count, 1).End(xlUp).Row

I use lr as a variable to hold the value for the last row
Cells is in a (row, column) format
Rows,count is a property of the Cells object, so is columns.count
.end is equivalent to holding Ctrl+Down, it can have an issue if there are blank spaces
I see some people use a cell address to start counting up from like 1048576 which currently the last row of newer versions of excel
older versions had 65536. a good practice to plan for bad data

[mperrah]

Also it is very important to count from bottom up or right to left if you plan to delete rows
as you count down from 1 to 10 if you delete row 4, 5 becomes 4 and the iteration is thrown off.
I guess from bottom up all the time would be ok,
but if you have a range that only deals with a few rows with no insert or delete
counting all the extra rows is an unnecessary memory expense

[mperrah]

altered to only check for A or D, removed input option...
noticed it fails to copy D if you run it several times, curious.
first time is no problem though


Sub vbax52593B()
' duplicate A and D row and shift down
Dim x, lr

lr = Cells(Rows.Count, 1).End(xlUp).Row

For x = 2 To lr
If Cells(x, 2).Value = "A" Or _
Cells(x, 2).Value = "D" Then
Range("A" & x & ":D" & x).Copy
Range("A" & x & ":D" & x).Offset(1).Insert shift:=xlDown
Application.CutCopyMode = False
x = x + 1
lr = lr + 1
Else
'MsgBox ("No match at " & x)
End If
Next x
End Sub

[mperrah]

fixed it by starting from bottom,
you can run it multiple times successfully, yeah

Sub vbax52593B()
' duplicate A and D row and shift down
Dim x, lr

lr = Cells(Rows.Count, 1).End(xlUp).Row

For x = lr To 2 Step -1
If Cells(x, 2).Value = "A" Or _
Cells(x, 2).Value = "D" Then
Range("A" & x & ":D" & x).Copy
Range("A" & x & ":D" & x).Offset(1).Insert shift:=xlDown
Application.CutCopyMode = False
Else
'MsgBox ("No match at " & x)
End If
Next x
End Sub

[equalizer]

Thanks for testing. I was confused by the Range A & D with my dataset A and D, but I figured out that Range() takes starting ending arguments.
Just happens to my match my dataset. Now I know to make sample dataset unique, Tom1, Tom2, etc.

[mperrah]

Glad to help

Be sure to mark your thread as "solved" using the Thread Tools link if your question has been sufficiently answered.
-mark

[mperrah]

Tried your offering for rows(x), me like :thumb

Sub vbax52593C()
' duplicate A and D row and shift down
Dim x, lr

lr = Cells(Rows.Count, 1).End(xlUp).Row

For x = lr To 2 Step -1
If Cells(x, 2).Value = "A" Or _
Cells(x, 2).Value = "D" Then
Rows(x).Copy
Rows(x).Offset(1).Insert shift:=xlDown
Application.CutCopyMode = False
Else
'MsgBox ("No match at " & x)
End If
Next x
End Sub

[equalizer]

Glad you liked it! So many different ways to do simple things, its confusing for beginners.

Can you explain syntax


Range("A" & x & ":D" & x).

and


shift:=xlDown

Once I get that down, I can close as solved.

[mperrah]

Sure thing,

Range("A" & x & ":D" & x)
I'm looping up through the rows with variable "x"
and when we find a match I want the 4 columns at the intersecting row to copy
so I need the range in the format
range("A2:D2")
excel looks at stuff in quotes as literal and stuff out of the quotes as a variable
and to get the variable in there I put the first literal in quotes "A" then the variable out of quotes "x"
note that these need to be combined with an "&" sign (like concatenating a string)
I always need to be sure to carefully in-quote and out-quote in pairs.

The
shift:=down is telling excel what to do with the displaced cells after it inserts the copied cells,
so it inserts our match then scoots the previous cell data down (instead of over-writing it)
another option is
shift:=right

hope this illuminates
-mark

[mperrah]

note: I found your use of
rows(x)
in post #3 accomplished the same task as my concatenated mess,


Range("A" & x & ":D" & x)
Hence my revised post #10

cheers
-mark