Cornel Westside
Cornel Westside

Reputation: 117

Creating a userform that copies and pastes into a new sheet

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

Answers (2)

CharlesPL
CharlesPL

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

Dmitrij Holkin
Dmitrij Holkin

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

Related Questions