Run time error

Can you supply a sample workbook?

Hi, Martin!
The problem is that sometimes it gives me an error and sometimes not!
I have this similar code for all sheets in the workbook and it will run through a few sheets- then error.
test-move.xlsm

VBA code rarely need to activate stuffs as it provide a bad user experience (things blinking everywhere, ouch my eyes) and it is slow.

And since you're repeating the same task, better factorise:
Also, cut/paste is not needed as you can simply assign a range to another, and clear the unwanted cell(s).

Sub moveHV()
    Dim Wb As Excel.Workbook
    Set Wb = ThisWorkbook
    
    Dim Ws As Excel.Worksheet
    Set Ws = Wb.Worksheets("HV")
    
On Error GoTo Error
    Dim Rng As Excel.Range
    Set Rng = Selection     '// Selection may not be a range, ehence the error handler
On Error GoTo 0
    
    If (Rng.Cells.Count > 1) Then
        MsgBox "Please, select a single cell.", vbOKOnly + vbInformation
    Else
        moveData "60200 · Auto", Rng
        moveData "62200 · Marketing", Rng
        moveData "62500 · Office Expenses", Rng
        moveData "66000 · Utilities", Rng
    End If
Exit Sub
Error:
    MsgBox "No cell selected!" & vbCrLf & vbCrLf & "Process aborted.", vbOKOnly + vbCritical
End Sub

Private Sub moveData(ByVal criteria As String, ByRef Rng As Excel.Range)
    Dim Ws As Excel.Worksheet
    Set Ws = Rng.Parent

    Dim Source As Excel.Range
    Set Source = Ws.Cells.Find(What:=criteria, After:=Rng, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not (Source Is Nothing) Then
        Dim Target As Excel.Range
        Set Target = Source.Offset(1, 0)
        Target = Source
        Source.Cells(1).Clear
    End If
End Sub

Select allOpen in new window

Thanks, Fabrice - I can't have any message boxes. I love the idea of consolidating the lookups!

Ideally, if it could look up those phrases through the entire workbook and move one cell down if it finds it - that would be fantastic!!

Hmmm, as it stand, one cell is lost as it is replaced by the one above it, regardless it hold data or not.
Does it matter ?

Do not have to worry about losing what was in the cell we are copying the text to.

It is just a matter of looping trough each worksheet and trough each column:

Sub moveHV()
    Dim Wb As Excel.Workbook
    Set Wb = ThisWorkbook
   
    Dim Ws As Excel.Worksheet
    For Each Ws In Wb.Worksheets
        Dim Column As Excel.Range
        For Each Column In Ws.UsedRange.Columns
            moveData "60200 · Auto", Column.Cells(1)
            moveData "62200 · Marketing", Column.Cells(1)
            moveData "62500 · Office Expenses", Column.Cells(1)
            moveData "66000 · Utilities", Column.Cells(1)
        Next
    Next
End Sub

Select allOpen in new window

 ActiveCell.Offset(1, 0).Select

Select allOpen in new window

Without testing, this should be always one row below the first found cell. So when there is a range of cells, then you get your overlap.

I’m glad I was able to help.

If you expand the “Full Biography" section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange Most Valuable Expert (MVE) 2015, 2017
              Experts Exchange Distinguished Expert in Excel 2018
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2020
              Experts Exchange Top Expert VBA 2018 to 2020

Martin,
This seemed to be running, but now that I look, the 60200 · Auto should move to the cell one row down, but it does not.
Not sure what I'm missing...

It does for me.
Maybe your data does not match "60200 · Auto" and is " 60200 · Auto" instead. See if changing LookAt:=xlWhole to LookAt:=xlPart makes a difference.

Oh, I see! It is inserting a row!
I need it to move the 60200 · Auto down one cell!
Example:
In B20? Move to B21

Try this instead.

Sub moveHV()
Dim rngFound As Range
Dim ws As Worksheet
Dim varArray As Variant
Dim lngEntry As Long

    Worksheets("HV").Activate
    Set ws = ActiveSheet
    
    With ws
        varArray = Array("60200", "62200", "62500", "66000")
        
        For lngEntry = 0 To UBound(varArray)
            Set rngFound = .Cells.Find(What:=varArray(lngEntry), LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, _
                MatchCase:=False, SearchFormat:=False)
            If Not rngFound Is Nothing Then
                .Rows(rngFound.Row).EntireRow.Insert
            End If
        Next
    End With
End Sub

Select allOpen in new window

That still just inserts a row. Please show me what rows 76 to 78 should look like,

Martin,
That also inserts a row (moving the 60200 down one row, yes)
But I need to offset, no insert row.

Please show me what rows 76 to 78 should look like,

Is this what you actually want? I ask because to get the data to look like your picture, 60200 would need to be moved down two rows rather than one.

Definitely only one row, thank you!!

That's it!!! THANK YOU!