[VBA] Insert additional row & data underneath the corresponding category in list

[shepeco]

Hi, I'm a bit new to VBA.

I'm trying to create a macro to insert a new row underneath the chosen category while copying the data to that newly created row.
Example:

https://imgur.com/a/efPERsO

I am also trying to create a checkbox to the right of the data, this helps with copying the checked list to another worksheet.

Any idea on how to achieve this?

I have been using this code as a reference:

Sub Button2_Click()
      Dim c As Range
      For Each c In Range("A:A")
        If c.Value Like "*BREAD, *COOKIES, *SCONES" Then
            c.Offset(1, 0).EntireRow.Insert
        End If
      Next
    Dim Area As Range, LastRow As Long
        On Error Resume Next
            LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, _
               SearchDirection:=xlPrevious, _
               LookIn:=xlFormulas).Row
            For Each Area In ActiveCell.EntireColumn(1).Resize(LastRow). _
               SpecialCells(xlCellTypeBlanks).Areas
                    Area.Value = Area(1).Offset(-1).Value
      Next
End Sub

 

[NoSparks]

Perhaps something along the lines of this

Sub Button1_Click()
    Dim findstring As String
    Dim fndRng As Range
    Dim CBX As CheckBox
' what to look for
findstring = Range("F7").Value
' where found
Set fndRng = ActiveSheet.Range("B:B").Find(findstring, , xlValues, xlWhole, xlRows, xlPrevious)
    If Not fndRng Is Nothing Then
    ' insert row
    fndRng.Offset(1).Resize(, 3).Insert shift:=xlDown
    ' populate the cells
    fndRng.Offset(1) = findstring
    fndRng.Offset(1, 1) = Range("G7")
    ' insert checkbox
        With fndRng.Offset(1, 2)
            Set CBX = .Parent.CheckBoxes.Add(Top:=.Top, Left:=.Left, Width:=.Width, Height:=.Height)
            CBX.Name = "CBX_" & .Address(0, 0)
            CBX.Caption = ""
            CBX.Value = xlOff   'initial value unchecked
            CBX.LinkedCell = .Offset(0, 0).Address  'cell the checkbox is on
            'CBX.OnAction = "macro to call"    'each time clicked
        End With
    Else
        MsgBox findstring & "  was not found"
    End If
End Sub

 

[shepeco]

Perhaps something along the lines of this

Sub Button1_Click()
    Dim findstring As String
    Dim fndRng As Range
    Dim CBX As CheckBox
' what to look for
findstring = Range("F7").Value
' where found
Set fndRng = ActiveSheet.Range("B:B").Find(findstring, , xlValues, xlWhole, xlRows, xlPrevious)
    If Not fndRng Is Nothing Then
    ' insert row
    fndRng.Offset(1).Resize(, 3).Insert shift:=xlDown
    ' populate the cells
    fndRng.Offset(1) = findstring
    fndRng.Offset(1, 1) = Range("G7")
    ' insert checkbox
        With fndRng.Offset(1, 2)
            Set CBX = .Parent.CheckBoxes.Add(Top:=.Top, Left:=.Left, Width:=.Width, Height:=.Height)
            CBX.Name = "CBX_" & .Address(0, 0)
            CBX.Caption = ""
            CBX.Value = xlOff   'initial value unchecked
            CBX.LinkedCell = .Offset(0, 0).Address  'cell the checkbox is on
            'CBX.OnAction = "macro to call"    'each time clicked
        End With
    Else
        MsgBox findstring & "  was not found"
    End If
End Sub

Exactly what I was looking for, I appreciate it greatly NoSparks!

 

[NoSparks]

You're welcome and thanks for reporting back