Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 206
Default Create RangeNames

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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4,339
Default Create RangeNames

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

"SIGE" wrote:

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

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 206
Default Create RangeNames

Hi Toppers,
Thanks a lot for your help ... it is working!
I have an issue though with the Application.Match(ListBox2.List(i),
Userrange, 0)-function ... does the Match-function not accept Integer
values ? (values in general?)
If I have a number in Listbox2.List(i) I get a type mismatch, error 13
message ...

Sige

(SIGE) wrote in message om...
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

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4,339
Default Create RangeNames

I see Tom Ogilvy has replied to your latest question.

"SIGE" wrote:

Hi Toppers,
Thanks a lot for your help ... it is working!
I have an issue though with the Application.Match(ListBox2.List(i),
Userrange, 0)-function ... does the Match-function not accept Integer
values ? (values in general?)
If I have a number in Listbox2.List(i) I get a type mismatch, error 13
message ...

Sige

(SIGE) wrote in message om...
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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Create a macro to create excel line graph with coloured pointers anddata lables anuj datta Charts and Charting in Excel 1 September 30th 09 04:04 PM
How to create adress list so can mail merge and create labels? adecocq Excel Discussion (Misc queries) 2 October 25th 06 12:32 AM
how to create a combo box in excel - how to create the drop down . @evy Excel Discussion (Misc queries) 2 August 18th 06 12:17 PM
How to create a form to insert a hyerlink.VBA code to create a for karthi Excel Discussion (Misc queries) 0 July 5th 06 11:26 AM
Create dictionary of terms, create first time user site Solitaire Jane Austin New Users to Excel 1 January 19th 06 09:47 PM


All times are GMT +1. The time now is 09:32 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"