Reputation: 117
I'm using Excel VBA. I need to create a macro button that launches a user form. The user form will ask for 3 arguments. "Worksheet Name", "Number of Countries", and "Order" (the first 2 inputs will be given in text boxes, but "Order" will be from a combo box). The macro should create a new sheet in the workbook, named whatever the user inputs for "Worksheet Name." There is an existing sheet in this workbook called "Countries", which lists some countries beginning at cell A2, and continuing down column A. Depending on the input for "Number of Countries", this macro should copy that number of countries from the existing list, and paste them onto the newly created worksheet. Finally, if the user selects "Reverse" as their input for "Order", the list should be flipped.
For example... you open the macro, enter "New Stuff", "5", and select "Reverse". After clicking "OK", Excel should create a New Stuff sheet where it pastes:
Chile Canada Britain Brazil Australia Argentina
This should all be done treating these lists as arrays.
Right now, I have a user form titled CreateList. It has text boxes titled SheetText and NumRows, and a combobox titled OrderList (which I want "Normal" and "Reverse" in as options).
The userform connects to the following code
Private Sub CreateList_Initialize()
OrderList.AddItem "Normal"
OrderList.AddItem "Reverse"
OrderList.ListIndex = 0
End Sub
Private Sub OKButton_Click()
Call CountrycPasting(SheetText.Value, NumRows.Value, OrderList.Value)
Unload Me
End Sub
Which connects to the following code:
Option Explicit
Sub CountryPasting(SheetText As String, NumRows As Integer, OrderList As String)
Dim Countries(NumRows) As Integer 'here's what my array should be
Dim Row As Integer
Worksheets.Add Before:=Worksheets(1)
ActiveSheet.Name = SheetText
Worksheets("Countries").Range(A2).Select
For Row = 1 To NumRows
Countries(Row) = Selection.Value
Selection.Offset(1, 0).Select
Next Row
Worksheet(SheetText).Range(A3).Select
For Row = 1 To NumRows
Selection.Value = Countries(Row)
Selection.Offset(1, 0).Select
Next Row
End Sub
Sub Load_Form()
CreateList.Show
End Sub
A bunch of problems here. First of all, "Normal" and "Reverse" don't even show up as options in the combo box on the user form. Also, I have no idea what to do about the reversing of the list. Something like, if OrderList.Value = Reverse then .... . And when I try to run this with just the first couple inputs, I get the error message "constant expression required" in regards to the "Dim Countries(NumRows) As Integer" line (I've tried dimming as a string, as well, to no avail).
Upvotes: 1
Views: 92
Reputation: 331
And when I try to run this with just the first couple inputs, I get the error message "constant expression required" in regards to the "Dim Countries(NumRows) As Integer" line (I've tried dimming as a string, as well, to no avail)
This error is raised because you cannot defined an array with a number of elements at run-time. If you want a dynamic array use this:
Dim Countries() As Integer
ReDim Countries(0 to NumRows)
Upvotes: 0
Reputation: 2055
For fillin combobox
Private Sub CreateList_Initialize()
With OrderList
.AddItem "Normal", 0 'add item to top of combobox
.AddItem "I'm at the bottom!", .ListIndex 'add item to bottom of combobox
.AddItem "Reverse", 2 'add item to third spot in userform
End With
End Sub
Main code
Sub CountryPasting(SheetText As String, NumRows As Long, OrderList As String)
Dim Countries()
Dim Row As Long, LastRow As Long
Dim Sht As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set Sht = wb.Worksheets("Countries")
'Naming Syntax: 1. You can use all alphanumeric characters but not the following special characters: \ , / , * , ? , : , [ , ]
SheetText = CleanSheetName(SheetText)
'Naming Syntax: 2. A worksheet name cannot exceed 31 characters.
If Len(SheetText) > 31 Then MsgBox "A worksheet name cannot exceed 31 characters.": Exit Sub
'Naming Syntax: 3. The name must be unique within a single workbook.
If wsExists(SheetText, wb) Then MsgBox "Worksheet " & SheetText & " Allready Exist": Exit Sub Else wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = SheetText
'LastRow = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row
Countries = Sht.Range("A2:A" & NumRows+2) 'LastRow)
If OrderList = "Reverse" Then
Countries = ReverseArray(Countries, True)
'Else
'Countries = ReverseArray(Countries)
End If
wb.Sheets(SheetText).Range("A3").Resize(NumRows) = Application.Transpose(Countries) ' put values to new sheet
End Sub
Function wsExists(wsName As String, wb As Workbook) As Boolean
Dim ws
For Each ws In wb.Sheets
wsExists = (wsName = ws.Name): If wsExists Then Exit Function
Next ws
End Function
Function CleanSheetName(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "[\[\]\*\\\/\?|:]"
CleanSheetName = .Replace(strIn, "") ' change forbiden characters with nothing
End With
End Function
Function ReverseArray(arr As Variant, Optional rev As Boolean = False) As Variant
Dim val As Variant
With CreateObject("System.Collections.ArrayList") '<-- create a "temporary" array list with late binding
For Each val In arr '<--| fill arraylist
.Add val
Next val
If rev Then .Reverse '<--| reverse it
ReverseArray = .Toarray '<--| write it into an array
End With
End Function
Upvotes: 1