kroy2008
kroy2008

Reputation: 175

Move selected range over one column with VBA in Excel 2016

I need to be able te

  1. Find a value in column A
  2. Select that value and everything above it
  3. Offset all those values over one column

The below code does just that - however, I am trying to speed up the code execution, and copy and paste actions slow it down. Is there a way to accomplish this without the cut/paste? I'd like to stick with VBA (vice formula) since this is part of a larger procedure.

Thanks!

Sub FindValueAndAboveThenMoveOver ()
    Dim sht1 as Worksheet
    Set sht1 = Sheets("Convert")

    sht1.Columns("A:A").Find("XXXX"), LookIn:=xlValues).Select
    Range(ActiveCell.Offset(0, 0), "A1").Select
    Selection.Cut
    Range("B1").Select
    ActiveSheet.Paste
End Sub

Upvotes: 3

Views: 6558

Answers (2)

Gary's Student
Gary's Student

Reputation: 96773

This might be slightly faster:

Sub FindValueAndAboveThenMoveOver()

    Dim sht1 As Worksheet, r As Range
    Set sht1 = Sheets("Convert")

    With sht1
        Set r = Range(.Range("A1"), .Columns("A:A").Find("XXXX", LookIn:=xlValues))
    End With

    r.Offset(0, 1).Value = r.Value
    r.Clear
End Sub

Upvotes: 1

SJR
SJR

Reputation: 23081

Nothing wrong with Cut and Paste, but you can avoid it, and avoiding Select will speed things up. Plus you should check first that you have found something to avoid an error.

Sub FindValueAndAboveThenMoveOver()

Dim sht1 As Worksheet, r As Range

Set sht1 = Sheets("Convert")
Set r = sht1.Columns("A:A").Find("XXXX", LookIn:=xlValues)

If Not r Is Nothing Then
    'should add sheet references here too
    With Range("A1").Resize(r.Row)
        Range("B1").Resize(r.Row).Value = .Value
        .ClearContents
    End With
End If

End Sub

Upvotes: 2

Related Questions