VBA to Copy range from Sheet to another and defined a name

Qaroos

In the FIRST attached revised file, the code below is assigned to your blue button (click it and it will run). Note that I cleared the data from sheet 2 (under WWW) so you can try it.

It uses one For/Next loop to find the text in cell GT291 on sheet 2 column B (and match the colour you used).

If found, a second loop looks for the first empty cell in B then copies values from Sheet 1 GT300:HN300 to that row. If the 8th row under that category is used, it warns the user.

It clears the sheet 1 data row, ready for the next new entry (or warns if GT291 isn't found for some reason).

The code is commented so you can follow and comment out bits you don't want (e.g. the one clearing copied data):

Sub RectangleRoundedCorners3_Click()

    Dim Opt As String

    ' caputre "category"
    Opt = Sheet1.Range("GT291").Value
    ' find category heading on sheet2
    For n = 3 To 33
        With Sheet2.Cells(n, 2)
            If .Value = Opt And .Interior.Color = 49407 Then
                'matched header and cell colour so loop down to find first blank row
                For p = 1 To 8
                    With .Offset(p, 0)
                        If .Value = "" Then
                           'column B blank so write values
                           .Resize(1, 21).Value = Sheet1.Range("GT300:HN300").Value
                           'warn user if necessary
                           If p = 8 Then MsgBox "Warning! Last row used for category " & Opt
                           Exit For
                        End If
                    End With
                Next p
                Exit For
            End If
        End With
    Next n

    If n < 34 Then
        'clear range and tell user
        Range("GT300:HN300").Value = ""
        MsgBox "Copied to sheet 2, row " & n + p

        Else
        MsgBox "Not copied, no matching category for " & Opt
    End If

End Sub

REVISION 23 November 2023

Further to the user's Discussion comments on Defined Names, it isn't clear what is required but my guess is included in the SECOND attached revised file. The bold portions are added (or changed) code to add a name for the added range:

Sub RectangleRoundedCorners3_Click()

    Dim Opt As String, n As Long, p As Long, DefNm As String

    ' capture "category"
    Opt = Sheet1.Range("GT291").Value
    ' find category heading on sheet2

    For n = 3 To 33
        With Sheet2.Cells(n, 2)
            If .Value = Opt And .Interior.Color = 49407 Then
                'matched header and cell colour so loop down to find first blank row
                For p = 1 To 8
                    With .Offset(p, 0)
                        If .Value = "" Then
                           'column B blank so write values
                           .Resize(1, 21).Value = Sheet1.Range("GT300:HN300").Value

                           ' define name , replacing any spaces with _ (undersore)
                           DefNm = Replace(Sheet1.Range("GV300").Value, " ", "_")
                           ' apply for added row, cells D:V
                           Sheet2.Names.Add DefNm, "=Sheet2!" & .Offset(0, 2).Resize(1, 19).Address

                           'warn user if necessary
                           If p = 8 Then MsgBox "Warning! Last row used for category " & Opt _
                                & vbCr & vbCr & "(You'll need to clear Defined Names to prevent muliple definitions)"
                           Exit For
                        End If
                    End With
                Next p
                Exit For
            End If
        End With
    Next n

    If n < 34 Then
        'clear NUMBERS range but leave formula in GV300 then tell user
        Range("GT300, GW300:HN300").Value = ""
        MsgBox "Copied to sheet 2, row " & n + p & " as Defined Name: " & DefNm

        Else
        MsgBox "Not copied, no matching category for " & Opt
    End If

End Sub

Note that I haven't included any checks on the existence of the new name to be created from the entry but the formula in cell GV300 is changed from:

=GT291&CONCAT(GX300:HS300)

to:

=If(CONCAT(GW300:HS300)<>"",GT291&CONCAT(GW300:HS300),"")

so it appears black without numbers entered but then appears as numbers are added to the (now) yellow cells GW300:HS:300. The formula is now retained once the entry has been made and the MessageBox reminds the user that, if that category is full, some defined names will need to be deleted.

As the file leaves me, the macro has already created a Defined Name of "WWW52081012345" (which refers to Sheet2!D4:V4) from an entry. I'm not sure why the user wants to use the names but that's not my concern!

Hope this fixes your problem. If so, please remember to mark this Answer as Selected