E
EWR
I have some code that based on the choice from a validation performs some
option. Below is the "Spread Row Only" code.
My problem is, when I run this with the calculation set to Manual, it runs
beautifully. If calcualtion is set to automatic, the cell with the
validation remains as the activecell and therefore the code can not run
properly.
I tried setting the calculation to manual at the start of the macro (like I
do in others) but the result did not change. I took out the screenupdating
line, no change. I had msgbox all throughout and they popped but the code
before and after was not being executed.
I am pulling my hair out...if anyone out there can give me the smallest of
hints...
thanks
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
Dim rng, DataRng, TrgtRng, ActsThru, trgtval, Cell As String
Dim trng, c As Range
Dim i, j As Integer
DataRng = ActiveWorkbook.Names("trgtrng").RefersToRange.Address
ActsThru = ActiveWorkbook.Names("ActsThru").RefersToRange.Address
If Not Application.Intersect(Target, Range(DataRng)) Is Nothing Then
Target.Select
TrgtRng = Target.AddressLocal()
Set trng = Range(TrgtRng)
For Each c In trng
c.Activate
Cell = ActiveCell.AddressLocal()
trgtval = ActiveCell.Value
If trgtval = "Spread Row Only" Then
Spread_Formulas (Cell)
...
Public Sub Spread_Formulas(cur_cell)
On Error GoTo lastline
Dim act_thru, beg_col, YrRng, ToGoCol, AmtCell, spread As String
Dim cnt
Application.ScreenUpdating = False
Range(cur_cell).Select
spread = ActiveCell.Value
act_thru = ActiveCell.Offset(0, 2).Value
'copy and paste current values
Application.Goto Reference:="JanYr2" 'here is the forst place where I
need the active cell to change and it is not!
beg_col = ActiveCell.Column
Cells(Range(cur_cell).Row, beg_col).Select
Range(ActiveCell.Address & ":" & ActiveCell.Offset(0, 12).Address).Select
Selection.copy
Range("BA" & ActiveCell.Row).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range(cur_cell).Select
Application.Goto Reference:="Yr2_Mnths"
YrRng = ActiveWorkbook.Names("Yr2_Mnths").RefersToRange.Address
If act_thru = "None" Or act_thru = "" Then
beg_col = ActiveCell.Column 'go to Jan of cur_row
Else
While ActiveCell.Value <> Format(act_thru, "mmm yyyy")
ActiveCell.Offset(0, 1).Select
Wend
ActiveCell.Offset(0, 1).Select 'one column past "ActsThru"
beg_col = ActiveCell.Column
End If
Cells(Range(cur_cell).Row, beg_col).Select
ToGoCol = Range("ToGoCol").Column
AmtCell = Cells(ActiveCell.Row,
ToGoCol).AddressLocal(rowabsolute:=False, columnabsolute:=True)
ActiveCell.Formula = "=" & AmtCell
ActiveCell.copy
ActiveCell.Offset(0, 1).Select
If act_thru = "None" Or act_thru = "" Then
cnt = 200502
Else
cnt = Format(act_thru, "yyyymm") + 2
End If
While cnt < 200513
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Select
cnt = cnt + 1
Wend
Application.CutCopyMode = False
Range(cur_cell).Select
ActiveCell.Value = "Formulas entered"
Selection.ClearComments
Range(cur_cell).AddComment
Range(cur_cell).Comment.Text Text:="Formulas entered on " & Now()
lastline:
ActiveCell.Offset(0, 1).Select
Application.ScreenUpdating = True
End Sub
option. Below is the "Spread Row Only" code.
My problem is, when I run this with the calculation set to Manual, it runs
beautifully. If calcualtion is set to automatic, the cell with the
validation remains as the activecell and therefore the code can not run
properly.
I tried setting the calculation to manual at the start of the macro (like I
do in others) but the result did not change. I took out the screenupdating
line, no change. I had msgbox all throughout and they popped but the code
before and after was not being executed.
I am pulling my hair out...if anyone out there can give me the smallest of
hints...
thanks
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
Dim rng, DataRng, TrgtRng, ActsThru, trgtval, Cell As String
Dim trng, c As Range
Dim i, j As Integer
DataRng = ActiveWorkbook.Names("trgtrng").RefersToRange.Address
ActsThru = ActiveWorkbook.Names("ActsThru").RefersToRange.Address
If Not Application.Intersect(Target, Range(DataRng)) Is Nothing Then
Target.Select
TrgtRng = Target.AddressLocal()
Set trng = Range(TrgtRng)
For Each c In trng
c.Activate
Cell = ActiveCell.AddressLocal()
trgtval = ActiveCell.Value
If trgtval = "Spread Row Only" Then
Spread_Formulas (Cell)
...
Public Sub Spread_Formulas(cur_cell)
On Error GoTo lastline
Dim act_thru, beg_col, YrRng, ToGoCol, AmtCell, spread As String
Dim cnt
Application.ScreenUpdating = False
Range(cur_cell).Select
spread = ActiveCell.Value
act_thru = ActiveCell.Offset(0, 2).Value
'copy and paste current values
Application.Goto Reference:="JanYr2" 'here is the forst place where I
need the active cell to change and it is not!
beg_col = ActiveCell.Column
Cells(Range(cur_cell).Row, beg_col).Select
Range(ActiveCell.Address & ":" & ActiveCell.Offset(0, 12).Address).Select
Selection.copy
Range("BA" & ActiveCell.Row).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range(cur_cell).Select
Application.Goto Reference:="Yr2_Mnths"
YrRng = ActiveWorkbook.Names("Yr2_Mnths").RefersToRange.Address
If act_thru = "None" Or act_thru = "" Then
beg_col = ActiveCell.Column 'go to Jan of cur_row
Else
While ActiveCell.Value <> Format(act_thru, "mmm yyyy")
ActiveCell.Offset(0, 1).Select
Wend
ActiveCell.Offset(0, 1).Select 'one column past "ActsThru"
beg_col = ActiveCell.Column
End If
Cells(Range(cur_cell).Row, beg_col).Select
ToGoCol = Range("ToGoCol").Column
AmtCell = Cells(ActiveCell.Row,
ToGoCol).AddressLocal(rowabsolute:=False, columnabsolute:=True)
ActiveCell.Formula = "=" & AmtCell
ActiveCell.copy
ActiveCell.Offset(0, 1).Select
If act_thru = "None" Or act_thru = "" Then
cnt = 200502
Else
cnt = Format(act_thru, "yyyymm") + 2
End If
While cnt < 200513
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Select
cnt = cnt + 1
Wend
Application.CutCopyMode = False
Range(cur_cell).Select
ActiveCell.Value = "Formulas entered"
Selection.ClearComments
Range(cur_cell).AddComment
Range(cur_cell).Comment.Text Text:="Formulas entered on " & Now()
lastline:
ActiveCell.Offset(0, 1).Select
Application.ScreenUpdating = True
End Sub