VBA to create specific named ranges and repeating process (Loop?) across columns

Hi vinothj86
The reason your code errors is that it's missing a Colon...see .jpg attached.
semi.jpg
I know this doesn't answer your broader question (which I'll look at) but thought you might wish to know.

Are you ALWAYS going to have 4 years and 4 products?

Hi vinothj86

Try this code to name your ranges. Change your Column Heading for Other Expenses to Other_Expenses (no blanks).

Sub Example()
    Dim vHdrs()
    Dim lMatch As Long
    Dim lngHdr As Long
    Dim rng As Range
    Const C_Sheet = "Database"
    Const C_Row = 1
    On Error GoTo ExitPoint
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    vHdrs = Array("Revenues", "Sells", "Comms", "Travs", _
            "Fairs", "Legal", "Trady", "Sport", "Misc", "Other_Expenses", "EBIT")
    For lngHdr = LBound(vHdrs) To UBound(vHdrs) Step 1
        lMatch = Application.Match(vHdrs(lngHdr), Sheets(C_Sheet).Rows(C_Row), 0)
        If IsNumeric(lMatch) Then
            Set rng = Cells(1, lMatch).Offset(2, 0).Resize(Range("B1"), Range("B2"))
            ActiveWorkbook.Names.Add Name:=vHdrs(lngHdr), refersto:=rng
        End If
    Next lngHdr
ExitPoint:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Hi Vinoth

I don't understand this as it was tested and ran fine for me on your sample file

I've just tested your code but it seems to stop after doing "revenues" correctly

Did you use a different file in your test?

I'll look at this and get back to you

the headers such as revenues, selling expenses etc will change from time to time ...Is there a way to make this dynamic?

Hi Vinoth

This code is in the attached and accommodates this

The other issue is that the headers such as revenues, selling expenses etc will change from time to time but in your code it appears to be defined (within the array function). Is there a way to make this dynamic?

' Adapted from http://stackoverflow.com/questions/6775165/collect-all-names-in-a-column-and-put-them-in-an-array-in-excel
Option Explicit
Sub Create_Named_Ranges()

    Dim i As Long
    Dim LC As Long
    Dim HeaderList As Range
    Dim cUnique As New Collection
    Dim Header() As String
    Dim lMatch As Long
    Dim lngHdr As Long
    Dim rng As Range

    With Sheets("Database")
        LC = .Cells.Find(What:="*", After:=[A1], _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious).Column
        Set HeaderList = .Range(.Cells(1, 3), .Cells(1, LC))
        'Loop over every column and add the value to the collection (with unique key)
        For i = 1 To HeaderList.Columns.Count
            On Error Resume Next
            If Not IsEmpty(HeaderList(1, i)) Then
                cUnique.Add HeaderList(1, i), CStr(HeaderList(1, i))
            End If
        Next i
        'Store back the value from the collection to an array
        ReDim Header(1 To cUnique.Count, 1 To 1)
        For i = 1 To cUnique.Count
            Header(i, 1) = cUnique(i)
        Next i
    End With
    For lngHdr = LBound(Header) To UBound(Header) Step 1
        lMatch = Application.Match(Header(lngHdr, 1), Sheets("Database").Rows(1), 0)
        If IsNumeric(lMatch) Then
            Set rng = Cells(1, lMatch).Offset(2, 0).Resize(Range("B1"), Range("B2"))
            ActiveWorkbook.Names.Add Name:=Header(lngHdr, 1), refersto:=rng
        End If
    Next lngHdr
End Sub

Let me know of issues.

Hi Vinoth

No that should NOT make it not work but there's something different about the file that IS making it not work.
Are you able to attach YOUR test file?