Macro to insert row and add data below.

[Xirom431]

Hi,

I have a spreadsheet with 26 Columns and 8500 rows. I would like to have a macro where I can search for a data XXXXX in Column Q, then insert entire row below data XXXX if found and add data YYYYY in the row below data XXXX in Column Q. Thanks in advance.

 

[John_w]

Try running this on a copy of your workbook, editing the Xstring and Ystring variables as required.

Sub Find_Data_and_Insert_Row()

    Dim Xstring As String, Ystring As String
    Dim FindData As Range
    Dim FirstAddress As String

    Xstring = "xyz"     'CHANGE AS REQUIRED
    Ystring = "987"     'CHANGE AS REQUIRED
    
    'Search for the X string in column Q of active sheet
        
    Set FindData = Columns("Q").Find(What:=Xstring, After:=Range("Q1"), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
    If Not FindData Is Nothing Then
    
        'Found, so save first cell address
        
        FirstAddress = FindData.Address
        Do
            'Insert a row below and put in the Y string
            
            FindData.Offset(1, 0).EntireRow.Insert
            FindData.Offset(1, 0).Value = Ystring
            
            'Search for X string again
            
            Set FindData = Columns("Q").FindNext(FindData)
            
            'Until not found or back to first cell
            
        Loop Until FindData Is Nothing Or FirstAddress = FindData.Address
    End If
    
End Sub

 

[Xirom431]

It worked great. Thank you very much John W.

 

[Xirom431]

Hi,

The macro above worked great. How can I also copy the info from XString in Columns E F I J K L to Columns E F I J K L in the new YString row? Thanks.

 

[Xirom431]

Any other suggestion? Thanks.

 

[John_w]

How can I also copy the info from XString in Columns E F I J K L to Columns E F I J K L in the new YString row?

This should do it:

Sub Find_Data_and_Insert_Row()

    Dim Xstring As String, Ystring As String
    Dim FindData As Range
    Dim FirstAddress As String

    Xstring = "xyz"     'CHANGE AS REQUIRED
    Ystring = "987"     'CHANGE AS REQUIRED
    
    'Search for the X string in column Q of active sheet
        
    Set FindData = Columns("Q").Find(What:=Xstring, After:=Range("Q1"), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
    If Not FindData Is Nothing Then
    
        'Found, so save first cell address
        
        FirstAddress = FindData.Address
        Do
            
            With FindData
            
                'Insert a row below and put in the Y string
                
                .Offset(1, 0).EntireRow.Insert
                .Offset(1, 0).Value = Ystring
            
                'Copy columns E-F and I-L from X string row to new row
                
                Range(Cells(.Row, "E"), Cells(.Row, "F")).Copy Cells(.Row + 1, "E")
                Range(Cells(.Row, "I"), Cells(.Row, "L")).Copy Cells(.Row + 1, "I")
            End With
                
            'Search for X string again
            
            Set FindData = Columns("Q").FindNext(FindData)
            
            'Until not found or back to first cell
            
        Loop Until FindData Is Nothing Or FirstAddress = FindData.Address
    End If
    
End Sub