VBA Offset within Loop - taking forever to run

Question

I'm brand new to programming, and I figured VBA is a good place for me to start since I do a lot of work in Excel.

I created a macro that takes an integer from an input box (I've been using 2, 3 and 4 to test) and it creates a set of a 4-tier hierarchy of that number; e.g. entering "2" would produce

1.0.0.0
1.0.0.1
1.0.0.2
1.0.1.0
1.0.1.1
1.0.1.2 etc.

I got the macro to work as intended, but it takes forever to run. I think it's the offsets within the loops that are slowing it down. Does anyone have any suggestions to speed this up? Any general feedback is welcome as well.

Sub Tiers()

'Input Box
Dim Square As Integer
Square = InputBox("Enter Number of Tiers")
Range("f5").Select
Selection.Value = 0
 With Application
    .ScreenUpdating = False
End With

'Rows down
Dim g As Integer
Dim h As Integer
Dim i As Integer
Dim j As Integer

'Start For loops
For g = 1 To Square
    For h = 0 To Square
        For i = 0 To Square
            For j = 0 To Square

                'calculate offsets and place values of loop variables
                Dim step As Long
                step = ((g - 1) * (Square + 1) ^ 3 - 1 + (h * (Square + 1) ^ 2) + Square * i + i + j + 1)
                Selection.Offset(step, 0).Value = j
                Selection.Offset(step, -1).Value = i
                Selection.Offset(step, -2).Value = h
                Selection.Offset(step, -3).Value = g


            Next j
        Next i
    Next h
Next g

With Application
    .ScreenUpdating = True
End With

End Sub

Thanks

Answer 1

Further to my comment below your post, looping and writing to sheets like this will be too slow. Write to an array and then write the array to worksheet. This ran in a blink of an eye.

Is this what you are trying?

Sub Sample()
    Dim TempArray() As Long
    Dim n As Long
    Dim g As Long, h As Long, i As Long, j As Long
    Dim reponse As Variant

    '~~> Accept only numbers
    reponse = Application.InputBox(Prompt:="Enter Number of Tiers", Type:=1)

    If reponse <> False Then
        For g = 1 To reponse
            For h = 0 To reponse
                For i = 0 To reponse
                    For j = 0 To reponse
                        n = n + 1
                    Next j
                Next i
            Next h
        Next g

        ReDim Preserve TempArray(1 To n, 1 To 4)
        n = 1

        For g = 1 To reponse
            For h = 0 To reponse
                For i = 0 To reponse
                    For j = 0 To reponse
                        TempArray(n, 1) = g
                        TempArray(n, 2) = h
                        TempArray(n, 3) = i
                        TempArray(n, 4) = j
                        n = n + 1
                    Next j
                Next i
            Next h
        Next g

        '~~> Replace this with the relevant sheet
        Sheet1.Range("A1").Resize(UBound(TempArray), 4).Value = TempArray
    End If
End Sub

Screenshot:

Answer 2

The step calculation seems superfluous:

step = ((g - 1) * (Square + 1) ^ 3 - 1 + (h * (Square + 1) ^ 2) + Square * i + i + j + 1)

Try the following:

Sub Tiers()

'Input Box
Dim Square As Long
Square = InputBox("Enter Number of Tiers")
With Application
    .ScreenUpdating = False
End With

'Rows down
Dim g As Long
Dim h As Long
Dim i As Long
Dim j As Long
Dim step As Long

step = 1

For g = 1 To Square
    For h = 0 To Square
        For i = 0 To Square
            For j = 0 To Square
                Range("F5").Offset(step, 0).Value = j
                Range("F5").Offset(step, -1).Value = i
                Range("F5").Offset(step, -2).Value = h
                Range("F5").Offset(step, -3).Value = g
                step = step + 1
            Next j
        Next i
    Next h
Next g

With Application
    .ScreenUpdating = True
End With

End Sub