Results 1 to 3 of 3

Thread: Macro to find a cell containing text, select range offset, cut and paste to lower row

  1. #1

    Macro to find a cell containing text, select range offset, cut and paste to lower row

    Register for a FREE account, and/
    or Log in to avoid these ads!

    I am trying to find a macro that can search a sheet for any cell that contains the text “Not on AOI,” selects a range that contains that cell, 81 rows below and all the data to the right, then cuts the selection and pastes it 162 rows below the original cell where the text was found.

    For a simplified example, I want to take a sheet that looks like this:
    NHA01 NHA01-Not on AOI NHA04 NHA04 NHA04- Not on AOI NHA07 NHA07 NHA07- Not on AOI
    1 1 5 0 0 7 2 2

    And make it look like:
    NHA01-Not on AOI NHA04 NHA04
    1 5 0
    NHA04- Not on AOI NHA07 NHA07
    0 7 2
    NHA07- Not on AOI
    Notice the number of columns between “Not on AOI” is variable.

    I’m very new to excel macros and the parts I think I’ve put together are:

    Cells.Find("Not on AOI", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=True).Activate


  2. #2
    Conjurer Simi's Avatar
    Join Date
    Feb 2012
    Utah, USA
    Excel Version
    Version 2002 Build 12527.20194
    This seems to work based on the sample data you provided.

    Sub simi_test()
    Dim lTotalColumns As Long
    Dim lCurrentColumn As Long
    Dim lCurrentRow As Long
    Dim iRowOffset As Integer
    Dim iRowDest As Integer
    Application.ScreenUpdating = False
    lCurrentColumn = 1
    lCurrentRow = 1
    iRowOffset = 1  'change this value to however many rows under the header row you want to copy.
    iRowDest = 2    'change this value to 1+ how many rows you want between the data in this example 2 will put 1 blank row between data
    With ActiveSheet
        lTotalColumns = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Do While lCurrentColumn <= lTotalColumns
            If InStr(1, .Cells(lCurrentRow, lCurrentColumn), "Not on AOI") > 0 Then
                .Range(.Cells(lCurrentRow, lCurrentColumn), .Cells(lCurrentRow + iRowOffset, lTotalColumns)).Copy
                .Range(.Cells(lCurrentRow + iRowOffset + iRowDest, lCurrentColumn), .Cells(lCurrentRow + iRowOffset + iRowOffset + iRowDest, lTotalColumns)).PasteSpecial Paste:=xlPasteAll
                .Range(.Cells(lCurrentRow, lCurrentColumn), .Cells(lCurrentRow + iRowOffset, lTotalColumns)).Clear
                lCurrentRow = lCurrentRow + iRowOffset + iRowDest
            End If
            lCurrentColumn = lCurrentColumn + 1
    End With
    Application.ScreenUpdating = True
    End Sub
    I added notes in the code for the places for you to change how many rows you want to copy and how many rows between the data you want.

  3. #3
    Thank you so much! This works perfectly.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts