VBA code to cut/paste entire row if value exists in cell

[Jastheace87]

Hi All,

I am a VBA newbie and would like some help with getting the code right

background:
row number of these values are never constant, ie one day row D6 might contain the keyword minor the next D65 might contain the word minor. (Refer to screenshot)

goal:

I want to script to search column D for the keyword "Minor" select that entire row, cut it and paste it below the last cell in column A that contains data, the delete all the blank cells that were cut

current data / formatting:

1	A	B	C	D	E
2	TRUE	TRUE	1	Moderate	yes
3	TRUE	TRUE	2	Moderate	no
4	TRUE	TRUE	3	Major	yes
5	FALSE	FALSE	4	Major	yes
6	TRUE	TRUE	5	Moderate	no
7	FALSE	FALSE	6	Moderate	yes
8	FALSE	FALSE	7	Moderate	yes
9	FALSE	FALSE	8	Minor	no
10	TRUE	TRUE	9	Major	yes
11	FALSE	FALSE	10	Minor	yes
12	FALSE	FALSE	11	Moderate	no

<tbody>
</tbody>

desired data / formatting

1	A	B	C	D	E	F
2	TRUE	TRUE	3	Major	yes	3/01/2020
5	FALSE	FALSE	8	Major	no	8/01/2020
6	FALSE	FALSE	10	Major	yes	10/01/2020
7	TRUE	TRUE	1	Moderate	yes	1/01/2020
8	TRUE	TRUE	2	Moderate	no	2/01/2020
9	TRUE	TRUE	5	Moderate	no	5/01/2020
10	FALSE	FALSE	6	Moderate	yes	6/01/2020
11	FALSE	FALSE	7	Moderate	yes	7/01/2020
12	FALSE	FALSE	11	Moderate	no	11/01/2020
13	FALSE	FALSE		Minor	no	3/01/2020
14	FALSE	FALSE		Minor	yes	4/01/2020
15	FALSE	FALSE		Minor	yes	9/01/2020
16	TRUE	TRUE		Minor	no	8/01/2020

<tbody>
</tbody>

I have the code to search for the value and cut it but cannot figure out how to paste it below the last row of data on the activesheet


Sub Find_Vaule_Cut_Paste_lastrow()
'
' Find_Vaule_Cut_Paste_lastrow Macro
'


Dim sht As Worksheet
Dim LastRow As Long

Dim c As Range
Dim cell As Range
Dim SrchRng As Range
Dim SrchStr As String
Set sht = ActiveSheet


LastRow = Range("A" & Rows.Count).End(xlUp).Row




Set SrchRng = ActiveSheet.Range("E:E")
SrchStr = ("Minor")
For Each cell In SrchRng
If cell.Value = SrchStr Then cell.EntireRow.Cut Destination:=Range("A:" & LastRow)
Next cell
' LastRow.Select.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


End Sub

 

[Jastheace87]

sorry examples say column D scripts says it will search column E, it is column E I need searched

 

[Fluff]

How about

Sub MoveMinor()
   Dim rng As Range
   With Range("E:E")
      .Replace "Minor", "=XXXMinor", xlWhole, , False, , False, False
      Set rng = .SpecialCells(xlFormulas, xlErrors)
      .Replace "=XXXMinor", "Minor", xlWhole, , False, , False, False
      rng.EntireRow.Copy Range("A" & Rows.count).End(xlUp).Offset(1)
      rng.EntireRow.Delete
   End With
End Sub

 

[Jastheace87]

Hi Fluff
So sorry for the delay in replying to your post, I have only just had a chance to check MRExcel. Thanks so much for your code it works like a charm

 

[Fluff]

Glad to help & thanks for the feedback