PDA

View Full Version : Solved: How To make Macro Interactive



Hamond
10-11-2009, 03:47 PM
Hi,

I have the code below that I created which copies a series (column) from a sheet called "source sheet", pastes it into a calculation sheet which performs various calculations and then copies the results into a result sheet. It then does the same for the next series/column in the source sheet.

However in the middle of the macro while it is running, I would like the macro to automatically pause at the line:
'XXXXXXXX PAUSE MACRO/INTERACT HERE XXXXXXXXXXXX.

When it does, at this point I would like to enter a number into a cell on the sheet manually (the number would depend on what a chart on the calculation sheet is showing) and once I've entered this, I would like the rest of the macro code to continue to run, e.g by clicking a button on the sheet to tell it when to continue. Then I would like it to stop again at the same point for the next series that's copied in from the source sheet and re-continue when I tell it to.

Anyone got any ideas what the most efficient way to do this would be?

Many Thanks,

Hamond

Sub Code()


Dim bestlag As Integer
Dim cellout As Range
Dim lastcell, firstcell, lastcelly, lastcol As Integer
Dim intCols As Integer
Dim rngData As Range
Application.ScreenUpdating = False

Sheets("Source Sheet").Select
lastcol = Sheets("Source Sheet").Range("c1").End(xlToRight).Column 'determines start and end for chart series
lastrow = Sheets("Source Sheet").Range("b5000").End(xlUp).Row + 20 'determines start and end for chart series
Sheets("Source Sheet").Range(Cells(1, 2), Cells(2, lastcol)).Copy 'select ranges using cells
Sheets("Results Sheet").Range("b1").PasteSpecial Paste:=xlPasteValues

For intCols = 2 To lastcol 'start from column 2 to last populated column (as determined in code above)
Set rngData = ThisWorkbook.Worksheets("Source Sheet") _
.Range(Worksheets("Source Sheet").Cells(1, intCols), _
Worksheets("Source Sheet").Cells(3000, intCols))

Worksheets("Calculation sheet").Range("C1:C" & lastrow).Value = rngData.Value

'Main code :
Worksheets("Calculation sheet").Select
lastcell = Sheets("calculation Sheet").Range("c2000").End(xlUp).Row 'determines start and end for chart series
firstcell = Sheets("calculation Sheet").Range("C4").End(xlDown).Row
lastcelly = Sheets("calculation Sheet").Range("B1000").End(xlUp).Row 'determines start and end for chart series
Set cellout = Range("F5") 'cell to start populating values

cellout.Offset(0, 0).Formula = "=abs(correl(" & "B" & (firstcell + 0) & ":" & "B" & lastcell & "," & "c" & _
firstcell & ":" & "c" & (lastcell - 0) & "))"
cellout.Offset(1, 0).Formula = "=abs(correl(" & "B" & (firstcell + 1) & ":" & "B" & lastcell & "," & "c" & _
firstcell & ":" & "c" & (lastcell - 1) & "))"
cellout.Offset(2, 0).Formula = "=abs(correl(" & "B" & (firstcell + 2) & ":" & "B" & lastcell & "," & "c" & _
firstcell & ":" & "c" & (lastcell - 2) & "))"
cellout.Offset(3, 0).Formula = "=abs(correl(" & "B" & (firstcell + 3) & ":" & "B" & lastcell & "," & "c" & _
firstcell & ":" & "c" & (lastcell - 3) & "))"
cellout.Offset(4, 0).Formula = "=abs(correl(" & "B" & (firstcell + 4) & ":" & "B" & lastcell & "," & "c" & _
firstcell & ":" & "c" & (lastcell - 4) & "))"
cellout.Offset(5, 0).Formula = "=abs(correl(" & "B" & (firstcell + 5) & ":" & "B" & lastcell & "," & "c" & _
firstcell & ":" & "c" & (lastcell - 5) & "))"
cellout.Offset(6, 0).Formula = "=abs(correl(" & "B" & (firstcell + 6) & ":" & "B" & lastcell & "," & "c" & _
firstcell & ":" & "c" & (lastcell - 6) & "))"

'XXXXXXXX PAUSE MACRO/INTERACT HERE XXXXXXXXXXXX

'CALCULATE STATS

Call Macro2
Call stationarytest
Application.Calculate
'Copies lag Headings into results sheet
'Sheets("Calculation Sheet").Range("E5:E36").Copy
'Sheets("Results Sheet").Range("A4").PasteSpecial Paste:=xlPasteValues
'Pastes lags
Sheets("Calculation Sheet").Range("F5:F36").Copy
Sheets("Results Sheet").Select

If (Range("B4") = "") Then

Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
'Range("a4").Select
Range("a4").End(xlToRight).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

Next
'Format Results
Range(Cells(4, 2), Cells(24, lastcol)).NumberFormat = "0.000" 'select ranges using cells
End Sub

mbarron
10-11-2009, 08:39 PM
If the cell you want to enter the value is consistent, you could use an input box that will enter the value into the cell.

You could do something as simple as:
Cells(1, 1) = Application.InputBox("number please")
or if the cell is not always the same:

Dim rngCell As Range
Set rngCell = Application.InputBox("Choose the cell", Type:=8)
rngCell = Application.InputBox("number please")

Hamond
10-12-2009, 07:08 AM
Hi,

Thanks for your suggestion mbarron. I've added the following line to the code and and turned on application screen updating:

Cells(28, 6) = Application.InputBox("Enter Lag")

But I can't see the information updating in the calculation sheet. It just ask to specify the lags without letting me see the updated calculated numbers and chart on the calculation sheet (based on each new column of data the macro pulls in), which I what I need to base the input on.

Is there a way I can see the data update on the calculation sheet?

Thanks,

Hamond

mbarron
10-13-2009, 07:02 PM
Try turning on the screen updating before the Application.Input and then back off after.

Application.ScreenUpdating = True
Cells(28, 6) = Application.InputBox("Enter Lag")
Application.ScreenUpdating = False

Hamond
10-15-2009, 10:50 AM
Hi MBarron,

Yes this works great.

Thanks,

Hamond