V
VBA_Newbie79
Hello everyone,
I haven’t received a response on my original posting, so I thought I would
try again.
I need to find a way for VBA to accept the text of items chosen from a
MultiSelect listbox as either sheet names or named ranges.
------------------------------------------
Code I posted in my original posting:
Private Sub CommandButton2_Click()
Dim res As Variant
Dim Last As Integer
For i = 0 To Change_Region.ListBox1.ListCount - 1
If Change_Region.ListBox1.Selected(i) Then
res = Application.VLookup(Change_Region.ListBox1.Text = i,
Worksheets("LISTS").Range("Regions"), 1, False)
If Not IsError(res) Then
Last = Columns("A:A").Find(What:="", LookAt:=xlWhole).Row
Change_Region.Hide
Application.ScreenUpdating = False
Worksheets(res).Select
Worksheets(res).Range(i).Copy Worksheets("Master").Range(Last +
1, 1)
Else
Change_Region.Hide
MsgBox "Match not made. Please try again."
Change_Region.Show
End If
Else
Change_Region.ListBox1.Clear
MsgBox "Please choose a region or click Cancel."
End If
Next i
End Sub
------------------------------------------
Altered code based on research:
Private Sub CommandButton2_Click()
Dim selCount As Long: selCount = 0
Dim selItems() As String
Dim ndx As Long
Dim arrndx As Long
selCount = selCount + 1
arrndx = 0
ReDim selItems(0 To selCount - 1)
For i = 0 To Change_Region.ListBox1.ListCount - 1
If Change_Region.ListBox1.Selected(i) = True Then
selItems(arrndx) = ListBox1.List(i)
arrndx = arrndx + 1
Application.VLookup(arrndx,
Worksheets("LISTS").Range("RegionRange"), 4, False) = k
Application.Goto (k)
Change_Region.Hide
Application.ScreenUpdating = False
Selection.Copy
Worksheets("CAPSDATA").Range("A1").Select
Selection.End(xlDown).Select 1
ActiveSheet.Paste
Else
Change_Region.Hide
MsgBox "Please choose a region or click Exit."
Change_Region.Show
End If
Next i
------------------------------------------
I haven’t received a response on my original posting, so I thought I would
try again.
I need to find a way for VBA to accept the text of items chosen from a
MultiSelect listbox as either sheet names or named ranges.
------------------------------------------
Code I posted in my original posting:
Private Sub CommandButton2_Click()
Dim res As Variant
Dim Last As Integer
For i = 0 To Change_Region.ListBox1.ListCount - 1
If Change_Region.ListBox1.Selected(i) Then
res = Application.VLookup(Change_Region.ListBox1.Text = i,
Worksheets("LISTS").Range("Regions"), 1, False)
If Not IsError(res) Then
Last = Columns("A:A").Find(What:="", LookAt:=xlWhole).Row
Change_Region.Hide
Application.ScreenUpdating = False
Worksheets(res).Select
Worksheets(res).Range(i).Copy Worksheets("Master").Range(Last +
1, 1)
Else
Change_Region.Hide
MsgBox "Match not made. Please try again."
Change_Region.Show
End If
Else
Change_Region.ListBox1.Clear
MsgBox "Please choose a region or click Cancel."
End If
Next i
End Sub
------------------------------------------
Altered code based on research:
Private Sub CommandButton2_Click()
Dim selCount As Long: selCount = 0
Dim selItems() As String
Dim ndx As Long
Dim arrndx As Long
selCount = selCount + 1
arrndx = 0
ReDim selItems(0 To selCount - 1)
For i = 0 To Change_Region.ListBox1.ListCount - 1
If Change_Region.ListBox1.Selected(i) = True Then
selItems(arrndx) = ListBox1.List(i)
arrndx = arrndx + 1
Application.VLookup(arrndx,
Worksheets("LISTS").Range("RegionRange"), 4, False) = k
Application.Goto (k)
Change_Region.Hide
Application.ScreenUpdating = False
Selection.Copy
Worksheets("CAPSDATA").Range("A1").Select
Selection.End(xlDown).Select 1
ActiveSheet.Paste
Else
Change_Region.Hide
MsgBox "Please choose a region or click Exit."
Change_Region.Show
End If
Next i
------------------------------------------