How to cut entire row based on a specific Text

user_15487739 0
Viewed 138

How to cut the entire row for any cell in column M that contains the word “ time “?

Noting that I want to keep the data in the same worksheet. However, cut to the very top.

January is the name of the sheet in the workbook.

Dim AW As long, I as long 
With Sheets("January")
    AW = .Range("M2:M" & Rows.Count).End(xlUp).Row

    For I = 1 to AW
        With .Range("M2:M" & I)
            If.Value = " Time" Then 
                .EntireRow.Cut Sheets("January").Cells(Rows.Count, "A") End(xlUP).offset(1,0)
autofilter cut vba excel
2 Answers
Sub TestRun()
   Call RemoveString("January", "Time", "M")
End Sub



Sub RemoveString(sheetName As String, txt As String, columnLetter As String)

Dim intLastRowNum As Long, intCellNum As Long
With Sheets(sheetName)
    intLastRowNum = .UsedRange.Rows.Count
    For intCellNum = 3 To intLastRowNum
         
            If LCase(.Range(columnLetter & intCellNum).Value) = LCase(txt) Then
                .Rows(intCellNum).EntireRow.Delete
                intCellNum = intCellNum - 1
            End If
            
         
    Next
End With
End Sub
user_120237260

Cut/Paste to Top

  • It is assumed that the data is in a table (one row of headers and data below) that starts in A1.
Option Explicit

Sub cutPasteToTop()
    
    Const wsName As String = "January"
    Const cCol As String = "M"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If
    
    Application.ScreenUpdating = False
    
    Dim irg As Range: Set irg = ws.Range("A1").CurrentRegion
    Dim rowsMoved As Boolean
    With irg
        .AutoFilter ws.Columns(cCol).Column, "Time"
        Dim rCount As Long
        rCount = WorksheetFunction.Subtotal(103, .Cells.Resize(, 1))
        If rCount > 1 Then
            Dim srg As Range
            Set srg = irg.Resize(irg.Rows.Count - 1).Offset(1) _
                .SpecialCells(xlCellTypeVisible)
            ws.AutoFilterMode = False
            irg.Rows(2).Resize(rCount - 1).Insert
            srg.Copy irg.Rows(2).Resize(rCount - 1)
            srg.Delete
            rowsMoved = True
        End If
    End With

    Application.ScreenUpdating = True

    If rowsMoved Then
        MsgBox "Rows moved.", vbInformation, "Success"
    Else
        MsgBox "Nothing moved.", vbExclamation, "Fail?"
    End If
    
End Sub
user_98140690
Related