Creating Named range as you are pasting data

[Scottie7275]

Hi all,

I really hope someone can help with this so that I can finish this project and move on.

I have the following code which copies data from one sheet and tries to find the matching supplier in another sheet. if it finds the supplier it pastes to the next empty row below that supplier name. If it does not find the supplier it pastes the supplier name and the data into the next empty column.

' Create table in data sheet

 
   
    Application.ScreenUpdating = False
    
    With Sheets("Data")
        x = .Cells(1, .Columns.Count).End(xlToLeft).Column
        On Error Resume Next
        Set rng = .Cells(1, 1).Resize(, x).Find(what:=Sheets("New Product or Supplier").Cells(4, 3).Value, LookIn:=xlValues, lookat:=xlWhole)
        On Error GoTo 0
        
        If Not rng Is Nothing Then
            .Cells(.Rows.Count, rng.Column).End(xlUp).Offset(1).Value = Sheets("New Product or Supplier").Cells(4, 4).Value
            Set rng = Nothing
        Else
               If Sheets("Data").Range("A1").Value = "" Then
        NextCol = 1
    Else
        NextCol = Sheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column + 1
    End If
    Sheets("Data").Cells(1, NextCol).Value = Sheets("New Product or Supplier").Range("C4").Value
    Sheets("Data").Cells(2, NextCol).Value = Sheets("New Product or Supplier").Range("D4").Value

What I am wanting is if it pastes to the next empty column then to name that range as the supplier name it has just pasted as the column header.

Any help is much appreciated.

Scottie