CODEWITHSUNDEEP
excelvba
Tony Chivers
Tony Chivers

Reputation: 191

I have VBA code that requires pop up boxes to work, can I automate this

Below is some code that splits a long column in excel into smaller columns.

This works by clicking into the module, pressing F5 and entering ranges, an output starting point and a cell range to signal the number of entries in each column.

Is there anyway I can automate this, for example, if I have a column with 1:30 starting in A1, I always want to use this range, the output cell I would like is H25 and I would like the number of entries based on whatever I input into say cell G6.

Sub SplitColumn()
    'Updateby20141106
    Dim rng As Range
    Dim InputRng As Range
    Dim OutRng As Range
    Dim xRow As Integer
    Dim xCol As Integer
    Dim xArr As Variant
    xTitleId     = "KutoolsforExcel"
    Set InputRng = Application.Selection
    Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type: = 8)
    xRow         = Application.InputBox("Rows :", xTitleId)
    Set OutRng   = Application.InputBox("Out put to (single cell):", xTitleId, Type: = 8)
    Set InputRng = InputRng.Columns(1)
    xCol         = InputRng.Cells.Count / xRow
    ReDim xArr(1 To xRow, 1 To xCol + 1)
    For i = 0 To InputRng.Cells.Count - 1
        xValue = InputRng.Cells(i + 1)
        iRow = i Mod xRow
        iCol = VBA.Int(i / xRow)
        xArr(iRow + 1, iCol + 1) = xValue
    Next
    OutRng.Resize(UBound(xArr, 1), UBound(xArr, 2)).Value = xArr
End Sub

Upvotes: 3

Views: 346

Answers (1)

Wizhi
Wizhi

Reputation: 6549

I think you want something like this...

So what do we need to change?... By press F8 in the VBA window we can step by step see what each line do..

1- This part defines your range to split, so we replace it:

Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type: = 8)

To a hard coded range:

Set InputRng = Range("A1:A30")

2- Next part defines which cell to output the result:

Set OutRng   = Application.InputBox("Out put to (single cell):", xTitleId, Type: = 8)

We hardcode this to cell range.

Set OutRng = Range("H22")

3- Last part to edit is this:

xRow         = Application.InputBox("Rows :", xTitleId)

Will take the value you have in G4

xRow = Cells(4, 7).Value

The final modifications can be more tricky to spot. The selection is hardcoded, so we don't need it. Therefore we can remove line Set InputRng = Application.Selection

If we don't have any value in G4 we will get a division by 0 error. We therefore create an IF statement that will show a message box "No Value in G4" if cell G4 is 0.

Modified code:

Sub SplitColumn()
    'Updateby20141106
    Dim rng As Range
    Dim InputRng As Range
    Dim OutRng As Range
    Dim xRow As Integer
    Dim xCol As Integer
    Dim xArr As Variant
    xTitleId = "KutoolsforExcel"
    Set InputRng = Range("A1:A30")
    xRow = Cells(4, 7).Value
    Set OutRng = Range("H22")
    If xRow = 0 Then
        MsgBox "No value in G4"
        Exit Sub
    Else
        Set InputRng = InputRng.Columns(1)
        xCol = InputRng.Cells.Count / xRow
        ReDim xArr(1 To xRow, 1 To xCol + 1)
            For i = 0 To InputRng.Cells.Count - 1
                xValue = InputRng.Cells(i + 1)
                iRow = i Mod xRow
                iCol = VBA.Int(i / xRow)
                xArr(iRow + 1, iCol + 1) = xValue
            Next i
        OutRng.Resize(UBound(xArr, 1), UBound(xArr, 2)).Value = xArr
    End If
End Sub

Upvotes: 5

Related Questions