Matching all Columns with specific reference in same row for string-CodePudding

I am writing a code that defines a named range based on a different set of columns. These columns are identified by all having the word "Dashboard" written in the same row.

The code works right now if I specify the exact columns (see below "C,E,H,O") but I am lost on how to have the code collect all matching columns and then creating the ColumnList from it.

Option Explicit

Sub Define_Chart_Range()

Dim ws As Worksheet
Dim lastRow As Long
Dim arrColumns As Variant
Dim strSelect As String
Dim i As Integer
Dim lnRow As Long, lnCol As Long

Dim myNamedRange As Range
Dim myRangeName As String

Set ws = ThisWorkbook.Sheets("Data_Range")

'finding all columns that have the word Dashboard in Row 3
lnRow = 3
lnCol = ws.Cells(lnRow, 1).EntireRow.Find(What:="Dashboard", _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False).Column


'Find the last used row in Column A
With ActiveSheet
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

' Describe what columns you want to select
Const ColumnList As String = "C,E,H,O"

' Row to start at
Const StartAtRow As Long = 8

' Create an array to hold columns
arrColumns = Split(ColumnList, ",")

 ' Define first column to select
strSelect = arrColumns(0) & StartAtRow
' and add rows to last ne found above
strSelect = strSelect & ":" & arrColumns(0) & lastRow

' Add rest of columns to selection list
For i = 1 To UBound(arrColumns)
    strSelect = strSelect & "," & arrColumns(i) & StartAtRow & ":" & arrColumns(i) & lastRow
Next i

' Defining name of Selected Columns as Named Range
Set ws = ThisWorkbook.Worksheets("Data_Range")
Set myNamedRange = ws.Range(strSelect)

'specify defined name
myRangeName = "Dashboard_Data"

'create named range with workbook scope. Defined name and cell range are as specified
ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange


End Sub

CodePudding user response：

You can use Union to directly build a range, without needing to work with range addresses.

Sub Define_Chart_Range()

    Const SearchRow As Long = 3
    Const StartAtRow As Long = 8
    Const RangeName As String = "Dashboard_Data"
    
    Dim ws As Worksheet, lastRow As Long
    Dim myNamedRange As Range, rng As Range, c As Range
    Dim myRangeName As String

    Set ws = ThisWorkbook.Sheets("Data_Range")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    'loop cells in row to search...
    For Each c In ws.Range(ws.Cells(SearchRow, 1), _
                           ws.Cells(SearchRow, Columns.Count).End(xlToLeft)).Cells
        If LCase(c.Value) = "dashboard" Then 'want this column
            'add to range
            BuildRange myNamedRange, _
                ws.Range(ws.Cells(StartAtRow, c.Column), ws.Cells(lastRow, c.Column))
           
        End If
    Next c
    
    Debug.Print myNamedRange.Address
    ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=myNamedRange

End Sub

'utility sub to build up a range using Application.Union
Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
    If rngTot Is Nothing Then
        Set rngTot = rngAdd
    Else
        Set rngTot = Application.Union(rngTot, rngAdd)
    End If
End Sub