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:

[TABLE="width: 897"]
<tbody>[TR]
[TD]1[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]TRUE[/TD]
[TD]TRUE[/TD]
[TD]1[/TD]
[TD]Moderate[/TD]
[TD]yes[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]TRUE[/TD]
[TD]TRUE[/TD]
[TD]2[/TD]
[TD]Moderate[/TD]
[TD]no[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]TRUE[/TD]
[TD]TRUE[/TD]
[TD]3[/TD]
[TD]Major[/TD]
[TD]yes[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]4[/TD]
[TD]Major[/TD]
[TD]yes[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]TRUE[/TD]
[TD]TRUE[/TD]
[TD]5[/TD]
[TD]Moderate[/TD]
[TD]no[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]6[/TD]
[TD]Moderate[/TD]
[TD]yes[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]7[/TD]
[TD]Moderate[/TD]
[TD]yes[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]8[/TD]
[TD]Minor[/TD]
[TD]no[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]TRUE[/TD]
[TD]TRUE[/TD]
[TD]9[/TD]
[TD]Major[/TD]
[TD]yes[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]10[/TD]
[TD]Minor[/TD]
[TD]yes[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]11[/TD]
[TD]Moderate[/TD]
[TD]no
[/TD]
[/TR]
</tbody>[/TABLE]

desired data / formatting

[TABLE="width: 1093"]
<tbody>[TR]
[TD]1[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]TRUE[/TD]
[TD]TRUE[/TD]
[TD]3[/TD]
[TD]Major[/TD]
[TD]yes[/TD]
[TD]3/01/2020[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]8[/TD]
[TD]Major[/TD]
[TD]no[/TD]
[TD]8/01/2020[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]10[/TD]
[TD]Major[/TD]
[TD]yes[/TD]
[TD]10/01/2020[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]TRUE[/TD]
[TD]TRUE[/TD]
[TD]1[/TD]
[TD]Moderate[/TD]
[TD]yes[/TD]
[TD]1/01/2020[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]TRUE[/TD]
[TD]TRUE[/TD]
[TD]2[/TD]
[TD]Moderate[/TD]
[TD]no[/TD]
[TD]2/01/2020[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]TRUE[/TD]
[TD]TRUE[/TD]
[TD]5[/TD]
[TD]Moderate[/TD]
[TD]no[/TD]
[TD]5/01/2020[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]6[/TD]
[TD]Moderate[/TD]
[TD]yes[/TD]
[TD]6/01/2020[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]7[/TD]
[TD]Moderate[/TD]
[TD]yes[/TD]
[TD]7/01/2020[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]11[/TD]
[TD]Moderate[/TD]
[TD]no[/TD]
[TD]11/01/2020[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD][/TD]
[TD]Minor[/TD]
[TD]no[/TD]
[TD]3/01/2020[/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD][/TD]
[TD]Minor[/TD]
[TD]yes[/TD]
[TD]4/01/2020[/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD][/TD]
[TD]Minor[/TD]
[TD]yes[/TD]
[TD]9/01/2020[/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD]TRUE[/TD]
[TD]TRUE[/TD]
[TD][/TD]
[TD]Minor[/TD]
[TD]no[/TD]
[TD]8/01/2020

[/TD]
[/TR]
</tbody>[/TABLE]

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