Create RangeNames

[SIGE]

Hi There,
I have a Userform with 2 listboxes:

*Listbox1 gets populated by my Sub "Get_Range_For_Accounts"
(= a number of columns in a certain row)
*Listbox2 is a selection out of Listbox1 (eg 5 column heads out of
100)
=>My Problem: I would like to create Ranges (ie different RangeNames)
for the selection I made in Listbox2 (these 5 column heads)... where
each of these ranges is going from this columnhead up till the last
row in that column which is containing data -as I do not know the
exact nr of rows-, so:

'Set BottomCell = Cells(16384, Listbox2_Selected_Name.Column)
'If IsEmpty(BottomCell) Then Set BottomCell = BottomCell.End(xlUp)

In short:
Under my "Private Sub OKButton_Click()" I would like to create as many
RangeNames as the user selected...

Hope someone understands what I would like to do...
All help welcome,
Sige

Sub Get_Range_For_Accounts()
Dim kolom As Integer
Dim Userrange As Range
Dim AccountOnRow As Integer
Dim RowCount As Integer
Dim RightCell As Range
' Make sure the RowSource property is empty
UserForm1.ListBox1.RowSource = ""

Prompt = "Select the line with the Account Names"
Title = "select the Row with Account Names..."

On Error Resume Next
Set Userrange = Application.InputBox(Prompt:=Prompt, Title:=Title,
Default:=ActiveCell.Address, Type:=8)
On Error GoTo 0

If Userrange Is Nothing Then
MsgBox "Canceled"

Else

RowCount = Userrange.Rows.Count
If RowCount > 1 Then
MsgBox "Select Only 1 row, i.e. the row with the Account
names in ..."
Exit Sub
Else
AccountOnRow = Userrange.row
'MsgBox AccountOnRow

' Add some items to the ListBox

Set RightCell = Cells(AccountOnRow, 256)
If IsEmpty(RightCell) Then Set RightCell =
RightCell.End(xlToLeft)

For kolom = 1 To RightCell
UserForm1.ListBox1.AddItem
Sheets("Sheet1").Cells(AccountOnRow, kolom)
Next kolom
UserForm1.Show
End If

End If
End Sub

'In Userform ...
Private Sub AddButton_Click()
Dim i As Integer

If ListBox1.ListIndex = -1 Then Exit Sub
If Not cbDuplicates Then
' See if item already exists
For i = 0 To ListBox2.ListCount - 1
If ListBox1.Value = ListBox2.List(i) Then
Beep
Exit Sub
End If
Next i
End If
ListBox2.AddItem ListBox1.Value
End Sub

Private Sub OKButton_Click()
Dim i As Integer
MsgBox "The 'To list' contains " & ListBox2.ListCount & " items."
For i = 0 To ListBox2.ListCount - 1
MsgBox ListBox2.List(i)
Next i
Unload Me
End Sub

 

[Toppers]

Hi,
I am no expert but add some code like this:


For i = 0 To ListBox2.ListCount - 1
MsgBox ListBox2.List(i)

col = Application.Match(ListBox2.List(i), Userrange, 0) ' Find column for
heading
iLastRow = Cells(Rows.Count, col).End(xlUp).Row ' Lastrow of data ...
Set rng = Range(Cells(2, col), Cells(iLastRow, col)) ' Set name range
ActiveWorkbook.Names.Add Name:=ListBox2.List(i), RefersTo:=rng

End i

This assumes the following:

Userrange always starts in column 1 so that "col "always equates to the
column number (rather than an offset).
I made "usserrange" public so that it was available to your "OKbutton" macro
Data starts in row 2.


as an alternative, you could keep a list of column numbers associated with
each heading to avoid using the Match statement.


HTH