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
    1
    NHA01-Not on AOI NHA04 NHA04
    1 5 0
    NHA04- Not on AOI NHA07 NHA07
    0 7 2
    NHA07- Not on AOI
    2
    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

    Range(ActiveCell,ActiveCell.Offset(81,2000)).Select
    Selection.Cut
    ActiveCell.Offset(162,0).Select
    Selection.Paste

  2. #2
    Conjurer Simi's Avatar
    Join Date
    Feb 2012
    Location
    Utah, USA
    Posts
    187
    Articles
    0
    This seems to work based on the sample data you provided.

    Code:
    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
        Loop
        
        .Range("A1").Select
        
    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
  •