Changes the value i get a loop ..... Problem Continues

  • Thread starter Thread starter stakar
  • Start date Start date
S

stakar

Ill try to be more specific

I have a vb code
When i running the vb code i calculate some values. The following i
one

A B C D
---------------
10
8 X1
5 X2
40 X3
10 X4

The X1 is the result of $C$1/A2
The X2 is the result of $C$1/A3
The X3 is the result of $C$1/A4
The X4 is the result of $C$1/A5

I want each time i change the $C$1 to another value, to
recalculate the values.

THE PROBLEM

The vb code is running under the Sheet2 BUT when it reaches the lin
that read "worksheets("sheet3").Cells.ClearContents "
goes to sheet3 and reads the

'Private Sub Worksheet_Change(ByVal Target As Range)'
I use the Application.EnableEvents = False at first but with no resul


Then goes out , continues with the rest code but when it reache
another line with worksheets("sheet3").mpla mpla mpla do the same a
above

Can anyone tell me how to do with that?

Thanks in advance
Stathi
 
Frank said:
*Hi
it would be best if you post your current code :-)
Click to expand...

Frank its a big one!
Also One part of the code is yours
I ll try to paste a part so you maybe understand!!

Private Sub CommandButton1_Click()
Dim ToggleButton1 As Control
Dim rngData As Range
Dim rngCell As Range
Dim lngMax As Long
Dim lngRows As Long
Dim lngLoop As Long
Dim lngValue As Long
Dim colUnique As New Collection
Dim aryOutput() As Long
Dim aryIn As Variant
Dim strValue As String
Dim lngColumns As Long

Dim wks_1 As Worksheet
Dim wks_2 As Worksheet
Dim wks_3 As Worksheet
Dim wks_4 As Worksheet

Set wks_1 = Worksheets(AAA)
Set wks_2 = Worksheets(BBB)
Set wks_3 = Worksheets(CCC)
Set wks_4 = Worksheets(DDD)

'Max Values procedure's parameters
Dim last_row As Integer
Dim RngC As Range
Dim Cll As Range '
'

Set rng = Range([BR4], [A65536].End(xlUp)(1, 70))

On Error GoTo Err_Handler
Set checkboxrange = [A1:BQ1].SpecialCells(xlCellTypeConstants, 2)
On Error GoTo 0

On Error Resume Next
Set checkboxrangeParagoga = [BG1:BQ1].SpecialCells(xlCellTypeConstants
2)

For Each ThisCell In checkboxrange
If Len(checkboxrangeParagoga) > 0 Then
s = s & "&""-""&" & ThisCell(4).Address(False, False)
Else
s = s & "&" & ThisCell(4).Address(False, False)
End If
Next ThisCell

'Turn off screen
Application.ScreenUpdating = False

rng.ClearContents
If Len(checkboxrangeParagoga) > 0 Then
[BR4] = "=" & Mid(s, 6, Len(s) - 5)
Else
[BR4] = "=" & Mid(s, 2, Len(s) - 1)
End If
[BR4].Copy rng

'changes the data type from value to string

Dim SourceArr() As Variant, TempVal
'Place data source into an array
SourceArr = Range("BR4:BR" & Range("A65536").End(xlUp).Row)
'Return the value as a string with the quote "'"
For lngLoop = 1 To UBound(SourceArr, 1)
TempVal = SourceArr(lngLoop, 1)
If ThisWorkbook.Worksheets("AAA").ToggleButton1.Value = True The
'The 01 report button
If TempVal <> "" Then
If TempVal > 0 Then
TempVal = 1
Else
TempVal = 0
End If
End If
End If
SourceArr(lngLoop, 1) = "'" & TempVal 'Mid(TempVal, 1)
Next lngLoop
'Place array into column BR
Range(Cells(4, 70), Cells(UBound(SourceArr, 1), 70)) = SourceArr

'clearcontents after the last row with data in BR
Range("BR" & Range("A2") + 4 & ":BR"
Range("BR65536").End(xlUp).Row).ClearContents

'refresh the Pivot table
Range("BT6").Select
ActiveSheet.PivotTables("PV1").RefreshTable

' Hit Skip PROCEDURE

'Turn off calculation to increase speed
Application.Calculation = xlCalculationManual

'Empty wks_3
wks_3.Cells.ClearContents
********************************************
'At this point start going to the the sheet with the following

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
Application.ScreenUpdating = False

Dim wks_1 As Worksheet
Dim wks_2 As Worksheet
Dim wks_3 As Worksheet
Dim wks_4 As Worksheet

Dim last_row As Integer
Dim RngC As Range
Dim Cll As Range

Set wks_3 = Worksheets("CCC")
Set wks_4 = Worksheets("DDD")

last_row = wks_4.Range("E65536").End(xlUp).Row
Set RngC = wks_3.Range("A4", wks_3.Range("A65536").End(xlUp))


For Each Cll In RngC.Offset(, 8)
Cll.FormulaArray = "=(SUMPRODUCT(('" & wks_4.Name & "'!E6:E" &
last_row & "=" & Cll.Offset(, _
-8).Address & ")*('" & wks_4.Name & "'!D6:D" & last_row &
"<=$I$3))-1)/(" & Cll.Offset(, -6).Address & "-1)" 'the first -1
because it counts the 1st blank cell"
Cll.Value = Cll.Value
If IsError(Cll.Value) Then
Cll.Value = 0
End If
Next Cll
'End If

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
***************************************************
Then goes out and comes back and i have a loop!
 
Back
Top