PDA

View Full Version : Defining Name Ranges Using VBA



bloodmilksky
04-18-2017, 05:57 AM
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
04-18-2017, 06:41 AM
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
04-19-2017, 05:45 AM
so by amending this will it create the ranges with the cell size mentioned

rlv
04-19-2017, 08:06 AM
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.