Efficient Macro

[Tian1]

Hallo,

I have got the following code which correcty puts various text in the required cells. I'm going to have to do this for a lot of loops and would thus just like to know if there is a more efficient way of achieving this. The code below is probably the most inefficient code to do what I would like to do.

Sub ResultCopy()

j = 1
For i = 1 To 24

Range("A" & i) = "Strategy " '& j
Range("B" & i) = j
    i = i + 1
    j = j + 1
    
Range("A" & i) = "Initial DD"
    i = i + 1
    
Range("A" & i) = "DD Increase"
    i = i + 1
    
Range("A" & i) = "1st YoR"
    i = i + 1
    
Range("A" & i) = "Life expectency"
    i = i + 1
    
Range("A" & i) = "AA"
Range("B" & i) = "ALSI"
Range("C" & i) = "ALBI"
Range("D" & i) = "Top40"
Range("E" & i) = "SA Property"
Range("F" & i) = "Int Equity"
Range("G" & i) = "Int Bonds"

    i = i + 2
    
Range("A" & i) = "Present Value"
    i = i + 1

Range("A" & i) = "Annuity"
    i = i + 1

Range("A" & i) = "Terminal Value"
    i = i + 1

Range("A" & i) = "Total"
    i = i + 1
    
Next i
End sub

 

[hiker95]

Tian1,

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sheet1

The below macro will ask you how many Strategy Tables do you want to enter:

If you enter a 2, you will get this:

Excel 2007
	A	B	C	D	E	F	G
1	Strategy	1
2	Initial DD
3	DD Increase
4	1 st YoR
5	Life expectency
6	AA	ALSI	ALBI	Top40	SA Property	Int Equity	Int Bonds
7
8	Present Value
9	Annuity
10	Terminal Value
11	Total
12
13	Strategy	2
14	Initial DD
15	DD Increase
16	1 st YoR
17	Life expectency
18	AA	ALSI	ALBI	Top40	SA Property	Int Equity	Int Bonds
19
20	Present Value
21	Annuity
22	Terminal Value
23	Total
24
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub CreateStrategyTables()
' hiker95, 09/15/2014, ME805507
Dim nr As Long, n As Long, i As Long
On Error GoTo MyExit
n = Application.InputBox("Enter the number of 'Strategy Tables' that you require?")
If n <= 0 Then GoTo MyExit:
Application.ScreenUpdating = False
Columns("A:G").ClearContents
For i = 1 To n
  nr = nr + 1
  Range("A" & nr).Resize(5).Value = Application.Transpose(Array("Strategy", "Initial DD", "DD Increase", "1 st YoR", "Life expectency"))
  Range("B" & nr).Value = i
  nr = nr + 5
  Range("A" & nr).Resize(, 7).Value = Array("AA", "ALSI", "ALBI", "Top40", "SA Property", "Int Equity", "Int Bonds")
  nr = nr + 2
  Range("A" & nr).Resize(4).Value = Application.Transpose(Array("Present Value", "Annuity", "Terminal Value", "Total"))
  nr = nr + 4
Next i
Columns("A:G").AutoFit
Application.ScreenUpdating = True
Exit Sub
MyExit:
On Error GoTo 0
MsgBox "You did not enter a number greater than 0 - macro terminated!"
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CreateStrategyTables macro.

 

[hiker95]

Tian1,

Please TEST the above macro in a blank worksheet.



The following macro will check to see if you have enough worksheet rows to display the results.

And, the following macro should be much faster, because it writes the results to an array in memory, and, then to the worksheet.

Please TEST this in a blank worksheet.

Sub CreateStrategyTables_V2()
' hiker95, 09/15/2014, ME805507
Dim a As Variant, i As Long, n As Long, lr As Long, c As Long, rc As Long
On Error GoTo MyExit
n = Application.InputBox("Enter the number of 'Strategy Tables' that you require?")
If n <= 0 Then GoTo MyExit:
rc = Rows.Count
lr = n * 12
If lr > rc Then GoTo NotEnoughRows
Application.ScreenUpdating = False
ReDim a(1 To lr, 1 To 7)
For i = 1 To lr Step 12
  c = c + 1
  a(i, 1) = "Strategy": a(i, 2) = c
  a(i + 1, 1) = "Initial DD"
  a(i + 2, 1) = "DD Increase"
  a(i + 3, 1) = "1 st YoR"
  a(i + 4, 1) = "Life expectency"
  a(i + 5, 1) = "AA": a(i + 5, 2) = "ALSI": a(i + 5, 3) = "ALBI": a(i + 5, 4) = "Top40"
  a(i + 5, 5) = "SA Property": a(i + 5, 6) = "Int Equity": a(i + 5, 7) = "Int Bonds"
  a(i + 7, 1) = "Present Value"
  a(i + 8, 1) = "Annuity"
  a(i + 9, 1) = "Terminal Value"
  a(i + 10, 1) = "Total"
Next i
Columns("A:G").ClearContents
Range("A1").Resize(lr, 7).Value = a
Columns("A:G").AutoFit
Application.ScreenUpdating = True
Exit Sub
NotEnoughRows:
MsgBox "You do not have enough sheet rows to display the number of " & vbLf & " 'Strategy Tables' that you require - macro terminated!"
Exit Sub
MyExit:
On Error GoTo 0
MsgBox "You did not enter a number greater than 0 - macro terminated!"
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CreateStrategyTables_V2 macro.

 

[Tian1]

Thank you very much for the code and thorough explanation above. Makes much more sense to use an array!

I appreciate the help!

 

[hiker95]

Tian1,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[Tian1]

Hallo Hiker95,

I hope you can help on this one..

The code you posted copies the format as many times as you want. I would now like to add something and I think it is best explained through this example:

The first loop (strategy 1) will set Worksheets("Calcs").Range("B4") equal to 1.
The second loop (strategy 2) will set Worksheets("Calcs").Range("B4") equal to 2.
The third loop (strategy 3) will set Worksheets("Calcs").Range("B4") equal to 3.
The fourth loop (strategy 4) will set Worksheets("Calcs").Range("B4") equal to 4.

Then..

The fifth loop (strategy 5) will set Worksheets("Calcs").Range("B4") equal to 1 again.
The sixth loop (strategy 6) will set Worksheets("Calcs").Range("B4") equal to 2.
And so the pattern should continue... "resetting" each time after 4 strategies.

As a further example I wrote this:

Sub Change_AA()

Dim j As Integer

ReDim a(1 To 4)
a(1) = 1
a(2) = 2
a(3) = 3
a(4) = 4

j = 1

For i = 1 To 8
    
    Cells(i, 1) = a(j)
    j = j + 1
    
    If j = 5 Then
        j = 1
    End If
    
Next i


End Sub

I guess I could just adapt the code above to the array code you posted, but I figured you would know best on how to make this as efficient as possible.

In advance, thank you for your help!

 

[hiker95]

Tian1,

The following is based on your latest request, and, your workbook must contain a worksheet named Calcs.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub CreateStrategyTables_V3()
' hiker95, 09/20/2014, ME805507
Dim a As Variant, i As Long, n As Long, lr As Long, c As Long, rc As Long
On Error GoTo MyExit
n = InputBox("Enter the number of 'Strategy Tables' that you require?")
If n <= 0 Then GoTo MyExit:
rc = Rows.Count
lr = n * 12
If lr > rc Then GoTo NotEnoughRows
Application.ScreenUpdating = False
ReDim a(1 To lr, 1 To 7)
For i = 1 To lr Step 12
  c = c + 1
  If c = 5 Then c = 1
  Sheets("Calcs").Range("B4") = c
  a(i, 1) = "Strategy": a(i, 2) = c
  a(i + 1, 1) = "Initial DD"
  a(i + 2, 1) = "DD Increase"
  a(i + 3, 1) = "1 st YoR"
  a(i + 4, 1) = "Life expectency"
  a(i + 5, 1) = "AA": a(i + 5, 2) = "ALSI": a(i + 5, 3) = "ALBI": a(i + 5, 4) = "Top40"
  a(i + 5, 5) = "SA Property": a(i + 5, 6) = "Int Equity": a(i + 5, 7) = "Int Bonds"
  a(i + 7, 1) = "Present Value"
  a(i + 8, 1) = "Annuity"
  a(i + 9, 1) = "Terminal Value"
  a(i + 10, 1) = "Total"
Next i
Columns("A:G").ClearContents
Range("A1").Resize(lr, 7).Value = a
Columns("A:G").AutoFit
Application.ScreenUpdating = True
Exit Sub
NotEnoughRows:
MsgBox "You do not have enough sheet rows to display the number of " & vbLf & " 'Strategy Tables' that you require - macro terminated!"
Exit Sub
MyExit:
On Error GoTo 0
MsgBox "You did not enter a number greater than 0 - macro terminated!"
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CreateStrategyTables_V3 macro.

 

[Tian1]

Thank you hiker95. Turns out I just over-think these problems!

Appreciate the help!

 

[hiker95]

Tian1,

Thanks for the feedback.

You are very welcome. Glad I could help again.

And, come back anytime.

 

[Tian1]

Hallo Hiker95,

Is there any way in which one can format the cells through the arrays?

For example, if I want the following to be HorizontalAlignment = xlCenter

a(i + 5, 1) = "AA": a(i + 5, 2) = "ALSI": a(i + 5, 3) = "ALBI": a(i + 5, 4) = "Top40" a(i + 5, 5) = "SA Property": a(i + 5, 6) = "Int Equity": a(i + 5, 7) = "Int Bonds"

Thank you
</pre>