I have a report that I have to update frequently with new data so for a better efficiency, I need that my range is not static (for instance A2:A10000) but to be updated based on the last row after an update and the new rows of new data (for instance, the first day A2:A7, the second day A8:A20, the third day A21:A23, etc.). Once the particular word is found, the macro will extract it in a new row because I need it to have its own one then delete any unnecessary spaces of the original row and sort the result. There are 2 options:

• Option 1: it will insert a row after finding the word. Recommended if your excel file doesn´t have a lot of formula referencing to the sheet
• Option 2: it will use the last row after finding the word. Recommended if your excel file is using intensively formula referencing to the sheet

 

When I use the macro ?

When I must extract particular words in a new single row for itself.

 

How to create the macro ?

Read How to create, edit, hide and select a macro in an excel report

 

How to create the button to associate it with the macro ?

Read How to create a button and associated it to a macro in an excel report

 

How is/are the macro(s) ?

Copy the code below and paste it into your macro. You will see my comments in green if exist so follow the help to adapt to your need.

First, I need to create a start row cell like that:

The number 2 corresponds to the row 2 where I will put my data since row 1 is the header and it is the starting number when I open the file the first time. This number will be updated after each update.

NOTE: in the picture, the “words (only informative)” columns are just to show you which words I am looking for.

Option 1:

Option Compare Text ' remove this line for case-sensitive
Sub test()
Dim searchrng1 As Range
Dim searchloop As Range
' change B by your word column and F2 by your start row
' if your start row is another sheet (i.e. Sheet2), change Range("G1") by Worksheets("Sheet2").Range("G1")
' change 3 based on the number of words, i.e. if you search for 5 words, change 3 by 5
Set searchrng1 = Range("B" & Range("G1").Value, "B" & Cells(Rows.Count, "B").End(xlUp).Row + 3)
For Each searchloop In searchrng1
  With searchloop
    ' change nt and unix by yours
    If .Value Like "*nt*" Or .Value Like "*unix*" Then
      Dim searchrng2 As Range
      Dim word1 As Range, word2 As Range
      Set searchrng2 = Range("B" & Range("G1").Value, "B" & Cells(Rows.Count, "B").End(xlUp).Row + 3)
      For Each word1 In searchrng2
        With word1
          If .Value Like "*nt*" Then
            ' change 4 by the number of characters including before and after spaces
            ' i.e NT has 2 characters + 1 space before + 1 space after
            If Len(word1) > 4 Then
              .Offset(1).EntireRow.Insert
              ' change -1 by the number of column before your word column and change 2 by the number of column after your word column
              ' i.e from B to A, there is -1 so if your word column is E to A, it should be -4
              ' i.e from B to D, there are 2 so if your word column is E and your last column is K, it should be 6
              Range(.Offset(0, -1), .Offset(0, 2)).Copy .Offset(1, -1)
              .Offset(0) = "NT"
              .Offset(1).Replace What:="nt", Replacement:=""
              .Offset(1).Replace What:="  ", Replacement:=" "
            End If
          End If
        End With
      Next word1
      For Each word2 In searchrng2
        With word2
          If .Value Like "*unix*" Then
            ' change 6 by the number of characters including before and after spaces
            ' i.e unix has 4 characters + 1 space before + 1 space after
            If Len(word2) > 6 Then
              .Offset(1).EntireRow.Insert
              Range(.Offset(0, -1), .Offset(0, 2)).Copy .Offset(1, -1)
              .Offset(0) = "unix"
              .Offset(1).Replace What:="unix", Replacement:=""
              .Offset(1).Replace What:="  ", Replacement:=" "
            End If
          End If
        End With
      Next word2
      Dim trimspace As Range
      For Each trimspace In Range("B" & Range("G1"), "B" & Cells(Rows.Count, "B").End(xlUp).Row)
        trimspace.Value = Trim(trimspace.Value)
      Next trimspace
    End If
  End With
Next searchloop
' change D by your last column
' change ("A2") by your sort column
' to sort from Z to A, change xlAscending by xlDescending
Range("A2:D" & Cells(Rows.Count, "A").End(xlUp).Row).Sort Key1:=Range("A2"), Order1:=xlAscending
Range("G1").Value = Cells(Rows.Count, 1).End(xlUp).Row + 1
End Sub              
              

Option 2:

Option Compare Text ' remove this line for case-sensitive
Sub test()
Dim searchrng1 As Range
Dim searchloop As Range
' change B by your word column and F2 by your start row
' if your start row is another sheet (i.e. Sheet2), change Range("G1") by Worksheets("Sheet2").Range("G1")
' change 3 based on the number of words, i.e. if you search for 5 words, change 3 by 5
Set searchrng1 = Range("B" & Range("G1").Value, "B" & Cells(Rows.Count, "B").End(xlUp).Row + 3)
For Each searchloop In searchrng1
  With searchloop
    ' change nt, unix and unix by yours
    If .Value Like "*nt*" Or .Value Like "*unix*" Then
      Dim searchrng2 As Range
      Dim word1 As Range, word2 As Range
      Set searchrng2 = Range("B" & Range("G1").Value, "B" & Cells(Rows.Count, "B").End(xlUp).Row + 3)
      For Each word1 In searchrng2
        With word1
          If .Value Like "*nt*" Then
            ' change 4 by the number of characters including before and after spaces
            ' i.e NT has 2 characters + 1 space before + 1 space after
            If Len(word1) > 4 Then
		      Dim lastrow1
		      lastrow1 = Cells(Rows.Count, 1).End(xlUp).Row + 1
              ' change -1 by the number of column before your word column and change 2 by the number of column after your word column
              ' i.e from B to A, there is -1 so if your word column is E to A, it should be -4
              ' i.e from B to D, there are 2 so if your word column is E and your last column is K, it should be 6
              Range(.Offset(0, -1), .Offset(0, 2)).Copy Range("A" & lastrow1)
              .Offset(0) = "NT"
              Range("B" & lastrow1).Replace What:="nt", Replacement:=""
              Range("B" & lastrow1).Replace What:="  ", Replacement:=" "
            End If
          End If
        End With
      Next word1
      For Each word2 In searchrng2
        With word2
          If .Value Like "*unix*" Then
            ' change 6 by the number of characters including before and after spaces
            ' i.e unix has 4 characters + 1 space before + 1 space after
            If Len(word2) > 6 Then
			  Dim lastrow2
			  lastrow2 = Cells(Rows.Count, 1).End(xlUp).Row + 1
              Range(.Offset(0, -1), .Offset(0, 2)).Copy Range("A" & lastrow2)
              .Offset(0) = "unix"
              Range("B" & lastrow2).Replace What:="unix", Replacement:=""
              Range("B" & lastrow2).Replace What:="  ", Replacement:=" "
            End If
          End If
        End With
      Next word2
      Dim trimspace As Range
      For Each trimspace In Range("B" & Range("G1"), "B" & Cells(Rows.Count, "B").End(xlUp).Row)
        trimspace.Value = Trim(trimspace.Value)
      Next trimspace
    End If
  End With
Next searchloop
' change D by your last column
' change ("A2") by your sort column
' to sort from Z to A, change xlAscending by xlDescending
Range("A2:D" & Cells(Rows.Count, "A").End(xlUp).Row).Sort Key1:=Range("A2"), Order1:=xlAscending
Range("G1").Value = Cells(Rows.Count, 1).End(xlUp).Row + 1
End Sub