Insert and name columns based on a named range

Question

Morning,

I need to insert rows into an excel spreadsheet sheet name "Product", based on information populated by a user in a column.

The user information is populated into a named range "SupReg" on sheet "Comments" column H4:H36. I would also need to import unique records excluding any blank spaces that might be entered by the user.

For every entry in "SupReg" 3 columns are inserted on to sheet "Product". I have code for this, what I need to do is name each of the inserted columns with the names from "SupReg" concatenated with the following suffixes, Delivered Cost,Collect Cost,Kvi.

The end result being

The code I am using for the inserting of the columns is as follows

Sub Supplier_Price()
Dim i As Integer
Dim i As Integer
Dim y As Integer
Dim SupplierReg As Variant


Set SupplierReg = Range("SupReg")

  MsgBox WorksheetFunction.CountA(Range("SupReg")) - 1 'To double check the SupReg qty
  x = WorksheetFunction.CountA(Range("SupReg")) - 1

 For i = 1 To x

      For y = 1 To 3 'Adds three columns for each SupReg entry
      Columns("Q:Q").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
     'Location of insert
     Next y

Next i
End Sub

Any other comments would be appreciated.

Thanks Mark

Answer 1

Sub Supplier_Price()
Dim i As Integer
Dim y As Integer
Dim SupplierReg As Range, c As Range, tmp


    Set SupplierReg = Range("SupReg")
    For Each c In SupplierReg.Cells
        tmp = Trim(c.Value)
        If Len(tmp) > 0 Then
            For y = 1 To 3
                Columns("Q:Q").Insert Shift:=xlToRight, _
                          CopyOrigin:=xlFormatFromLeftOrAbove
            Next y
            Range("C1").Resize(1, 3).Value = _
               Array(tmp & " Delivered", tmp & " Collect", tmp & "Kvi")
        End If
    Next c


End Sub