Macro to copy rows if detects a specfic key word

[Misbah211]

Hi,

I'm after a macro that would copy all the rows that has "OPEN POT" in column G to from cell range D25:S39, and then pasted to cell range D10:S19 withinin the same sheet.

Thanks in advance!

[Misbah211]

Hi again, I attempted at manipulating a similar macro but I just can't get it to work. I'm a novice with coding so I can't troubleshoot the problem. Hope someone can help out.

Public Sub Tester()
Dim rng As Range
Dim rCell As Range
Dim copyRng As Range
Dim destRng As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim CalcMode As Long
Dim arr As Variant

Set WB = ActiveWorkbook 
Set SH = WB.Sheets("Business Analytics")
Set rng = SH.Range("D25:S39")
Set destRng = WB.Sheets("Business Analytics").Range("D10")

arr = Array("OPEN POT")


With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In rng.Cells
If Not IsError(Application.Match(rCell.Value, arr, 0)) Then
If copyRng Is Nothing Then
Set copyRng = rCell
Else
Set copyRng = Union(rCell, copyRng)
End If
End If
Next rCell

If Not copyRng Is Nothing Then
copyRng.EntireRow.Copy Destination:=destRng
Else
'nothing found, do nothing
End If

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub

[Misbah211]

Bump, can anyone help?

[Steven8294]

Im pretty new to vb also but just something I noticed, you have used rCell but not defined what it is exactly however you have Dim'd it as a Range

Not too sure if this helps.

[Misbah211]

Hey, emm I'm new to vba as well, a complete novice if I'm honest. What it is that I tried manipulating an existing macro I found on Google, that was used to move rows from other sheets. But I'm trying to move rows within the same sheet depending on a specific criteria.

[Steven8294]

Im not on a computer right now. Ill try later

[Misbah211]

Cheers mate, heres the spreadsheet if it helps

Test Spreadsheet.xlsm

[Steven8294]

Misbah,

You have left the password on the vb.