简体   繁体   中英

Adding a column to a named range based on a cell value

I'm trying to create a macro which will be adding a column to a named range provided on the value in a column next to a named range.

To be more specific, the range B:G is named "Furniture". Depending on the value in the first row of a column next to this range (A or H), I need to add a column to this named range. So if a cell H1 is "Furniture" then column H will be added to the named range "Furniture".

Of course, it has to be a universal method so that every column named "Furniture" next to this range will be added to it.

I'm a complete newbie to VBA, so I created a code attached below for a singular case. However, it doesn't work and, moreover, it's not a general code.

Range("H1").Select
If cell.Value = "Furniture" Then
With Range("Furniture")
.Resize(.Columns.Count + 1).Name = "Furniture"
End With
End If

If you could provide more information about the structure of your sheet, I could help you with a decent loop, because it's not clear how you want to loop through the columns / rows. Can the target range always be found in the first row of every column?

For now, this will help you hopefully, as it dynamically adds columns to a range. The name of the particular range comes from the selected cell.

lastColumn = Range("A1").SpecialCells(xlCellTypeLastCell).Column


For currentColumn = 1 To lastColumn

    Cells(1, currentColumn).Activate

    If Not IsEmpty(ActiveCell.Value) Then

        targetRange = ActiveCell.Value

        ActiveCell.EntireColumn.Select

        On Error Resume Next

        ActiveWorkbook.Names.Add Name:=targetRange, RefersTo:=Range(targetRange & "," & Selection.Address)

        If Err <> 0 Then

            Debug.Print "Identified range does not exists: " & targetRange

        Else

            Debug.Print "Identified range found, extended it with " & Selection.Address

        End If

    End If

Next currentColumn

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM