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
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