VBA macro if multiple criteria is met insert row above and heading

[slohman]

I would like to be able to check my data and if the word "Type" Column A and "*Essentials*" Column J (would need to use a wildcard) not on the same rows is found then add a row and add the words Play > Essentials. I only need this to happen once for a Heading, and then to look further down my data for other words like "Elevate" or "Orbit" and do the same thing with the word Play > Elevate or Play > Orbit

Data is on Sheet (ProductsCopied) and is getting copied from another Sheet (Products)

The macro attached can be updated for this to happen but I dont know how to.

Sub FilteredDataSelection()
Dim wsProducts As Worksheet
Dim wsProductsCopied As Worksheet
Dim wsPriceList As Worksheet
Dim lngLastrow  As Long
Dim strCategory As String
Dim i As Integer
Dim rngCategories As Range
Dim c As Range
Dim rng As Range
Dim intRow As Integer
Dim LastRow As Long, erow As Long

    
Application.ScreenUpdating = False
    
    Call subDeleteWorksheet("ProductsCopied")
    
    Sheets.Add.Name = "ProductsCopied"
    
    ' Create Price List sheet.
    'Worksheets.Add After:=Worksheets("ProductsCopied")
    'ActiveSheet.Name = "Price List"
    
    Set wsPriceList = Worksheets("Price List")
    
    Set wsProductsCopied = Worksheets("ProductsCopied")
 
    Set wsProducts = ThisWorkbook.Worksheets("Products")
 
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

'-----PLAY > ESSENTIALS
    Sheets("Products").Activate
    
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
    

    ActiveSheet.Range("A1:ADU5000").AutoFilter Field:=11, Criteria1:="=*Essentials*"

    Application.DisplayAlerts = False

    wsProducts.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy 'copy the AF first
  
    Set rng = wsProducts.UsedRange.Offset(0, 1)
    Set rng = rng.Resize(rng.Rows.Count)
  
    rng.Copy
 
    Sheets("ProductsCopied").Activate
 
    lr = ThisWorkbook.Worksheets("ProductsCopied").Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row + 1
    Range("A" & lr).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To LastRow
    If IsEmpty(Cells(i, 1)) Then
      Cells(i, 2).Value = "Play > Essentials"
    'End If
    'Next i
    
    
    Application.DisplayAlerts = True
    


'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

'-----PLAY > ELEVATE
    Sheets("Products").Activate
    
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
    

    ActiveSheet.Range("A1:ADU5000").AutoFilter Field:=11, Criteria1:="=Play > Elevate*"

    Application.DisplayAlerts = False

    wsProducts.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy 'copy the AF first
  
    Set rng = wsProducts.UsedRange.Offset(0, 1)
    Set rng = rng.Resize(rng.Rows.Count)
  
    rng.Copy
 
    Sheets("ProductsCopied").Activate
 
    lr = ThisWorkbook.Worksheets("ProductsCopied").Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row + 2
    Range("A" & lr).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    

    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    If IsEmpty(Cells(i, 1)) Then
      Cells(i, 2).Value = "Play > Elevate"
    'End If
    'Next i
    
    
    Application.DisplayAlerts = True
    

'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

'-----PLAY > ORBIT
    Sheets("Products").Activate
    
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
    

    ActiveSheet.Range("A1:ADU5000").AutoFilter Field:=11, Criteria1:="=*Orbit,*"

    Application.DisplayAlerts = False

    wsProducts.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy 'copy the AF first
  
    Set rng = wsProducts.UsedRange.Offset(0, 1)
    Set rng = rng.Resize(rng.Rows.Count)
  
    rng.Copy
 
    Sheets("ProductsCopied").Activate
 
    lr = ThisWorkbook.Worksheets("ProductsCopied").Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row + 2
    Range("A" & lr).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    

    Application.DisplayAlerts = True

    
    ActiveWorkbook.Save
    
Application.ScreenUpdating = True

End Sub

 

[BobBridges]

I'm guessing that the reason no one's answered this yet is that your question isn't very clear yet. Let me attempt this translation:

"Check my data": Look through all the cells in a single worksheet. probably the one you mentioned later ("ProductsCopied").

"if the word 'Type' Column A": "If the program finds 'Type' in any cell in col A"

"if the word '*Essentials*' Column J": "If the program finds '*Essentials*' in any cell in col J"

"not on the same rows": the hit for cols A and J must not be on the same row

"add a row": After the last row in the worksheet, I suppose

"add the words Play > Essentials": Just guessing, but probably write "Play > Essentials" into col A of the new row

"only need this to happen once for a Heading": No idea what this could mean

"look further down my data": keep searching in cols A and J from that point, looking for ....

"other words like 'Elevate' or 'Orbit' ": What words are "like" 'Elevate' and 'Orbit'? Would "space" qualify? "Elevator"? "Vacuum"? "Empty"? "Rocket"? I kind of break down at this point.