Defining Name Ranges Using VBA

[bloodmilksky]

Hi Guys, I hope you are all well.

I am trying to use the values in column A Sheet 1 as names for Ranges on Sheet 2. The ranges size would be 4 cells wide by 12 cells down. I managed to find the below code but cant work out where it defines the range size so that I can adjust it.

Would anyone know either how to amend the below to fit the above requirement or know of some better code to do this?

Sub TransposeRange_new_code()    Dim OutRange              As Range
    Dim x As Long, y As Long
    Dim sKey As String
    Dim maxCount As Long
    Dim data, dic, keys, items, dataout()


    Application.ScreenUpdating = False
    data = Sheet1.Range("A2:E" & Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row).Value2


    Set dic = CreateObject("scripting.dictionary")
    Set OutRange = Sheet2.Range("B2")


    For x = 1 To UBound(data, 1)
        If Trim$(data(x, 1)) <> "_" Then
        sKey = Trim$(data(x, 1)) & Chr(0) & Trim$(data(x, 2))
        If Not dic.exists(sKey) Then dic.Add sKey, CreateObject("Scripting.Dictionary")
        dic(sKey).Add x, Array(data(x, 4), data(x, 5))
        If dic(sKey).Count > maxCount Then maxCount = dic(sKey).Count
        End If
    Next


    ReDim dataout(1 To maxCount + 1, 1 To dic.Count * 3)
    keys = dic.keys
    items = dic.items
    For x = LBound(keys) To UBound(keys)
        dataout(1, x * 3 + 1) = Split(keys(x), Chr(0))(0)
        dataout(1, x * 3 + 2) = Split(keys(x), Chr(0))(1)
        For y = 1 To items(x).Count
            dataout(1 + y, x * 3 + 1) = items(x).items()(y - 1)(0)
            dataout(1 + y, x * 3 + 2) = items(x).items()(y - 1)(1)
        Next y
    Next




    OutRange.Resize(UBound(dataout, 1), UBound(dataout, 2)).Value2 = dataout


    For x = 1 To UBound(keys)
        OutRange.Offset(0, (x - 1) * 3).Resize(maxCount, 2).Name = "" & validName(Split(keys(x - 1), Chr(0))(0))
        With OutRange.Offset(0, (x - 1) * 3 + 1)
            .Hyperlinks.Add anchor:=.Cells(1), Address:="mailto://" & .Value2, TextToDisplay:=.Value2
        End With
    Next


End Sub

any help would be greatly appreciated

many thanks

Jamie

[rlv]

The range is defined by this statement

    data = Sheet1.Range("A2:E" & Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row).Value2

data is a variant being used as an array. The range being loaded into the array is defined by

Sheet1.Range("A2:E" & Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row)

If you re-write the expression to use some intermediate variables, it will be clearer.

    Dim LastCellRange As Range
    Dim LastRow As Long
    Dim RangeAddressString As String


    Set LastCellRange = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp)    'this is the last non-empty cell in column A
    LastRow = LastCellRange.Row    'the row number of LastCellRange
    RangeAddressString = "A2:E" & LastRow    'the address of the range of cells to load into the array


    data = Sheet1.Range(RangeAddressString).Value2

[bloodmilksky]

so by amending this will it create the ranges with the cell size mentioned

[rlv]

The intent of my post was to help you see where your posted sub (TransposeRange_new_code) defines the range size so that you can adjust it. I assumed you were going to do some experimentation with it to see if it met your needs. The larger issue of how you are trying to use this sub with respect to sheet1 & sheet2 is too vaguely defined so I did not address it.
Your response makes me suspect we might be in "XY Problem" territory with respect to the posted sub. I've found that a general rule on this forum is that the clearer and more detailed your problem description is, the more likely people are to help, and often nothing beats posting a sample workbook with sample data and/or your coding attempts for others to look at.