# Efficient Macro

#### Tian1

##### Board Regular
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.

Code:
``````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``````

### Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

#### hiker95

##### Well-known Member
Tian1,

Sample raw data:

Excel 2007
ABCDEFG
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
ABCDEFG
1Strategy1
2Initial DD
3DD Increase
41 st YoR
5Life expectency
6AAALSIALBITop40SA PropertyInt EquityInt Bonds
7
8Present Value
9Annuity
10Terminal Value
11Total
12
13Strategy2
14Initial DD
15DD Increase
161 st YoR
17Life expectency
18AAALSIALBITop40SA PropertyInt EquityInt Bonds
19
20Present Value
21Annuity
22Terminal Value
23Total
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
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.

Code:
``````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

##### Well-known Member
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.

Code:
``````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.

Last edited:

#### Tian1

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

I appreciate the help!

#### hiker95

##### Well-known Member
Tian1,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

#### Tian1

##### Board Regular
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:
Code:
``````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.

#### hiker95

##### Well-known Member
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).

Code:
``````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

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

Appreciate the help!

#### hiker95

##### Well-known Member
Tian1,

Thanks for the feedback.

You are very welcome. Glad I could help again.

And, come back anytime.

#### Tian1

##### Board Regular
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

Code:
``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>

Replies
5
Views
317
Replies
0
Views
598
Replies
3
Views
328
Replies
6
Views
2K
Replies
4
Views
314

### Forum statistics

1,191,195
Messages
5,985,225
Members
439,950
Latest member
Xearo96 ### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?    1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option. Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com". Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back