PDA

View Full Version : Solved: convert worksheet_change to module sub



mperrah
11-12-2007, 11:01 PM
This is a worksheet_change procedure I am trying to call like a regular sub. It doesn't fire when I change the values with screen updating off (I think)
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.cells.Count > 1 Then Exit Sub
If Target.Row > 1 And _
Target.Column = 2 Then
With Target
.Offset(0, -1).Formula = "=if(C" & .Row & "="""","""",C" & .Row & "&"" ""&B" & .Row & ")"
.Offset(0, 2).Formula = "=IF(C" & .Row & "="""","""",SUM(E" & .Row & ":F" & .Row & "))"
.Offset(0, 3).Formula = "=IF(C" & .Row & "="""","""",SUMPRODUCT(--(Techs=$C" & .Row & "),--(Pass=scan_pass),--(QCDate>=wqcStart),--(QCDate<=wqcEnd)))"
.Offset(0, 4).Formula = "=IF(C" & .Row & "="""","""",SUMPRODUCT(--(Techs=$C" & .Row & "),--(Fail=scan_fail),--(QCDate>=wqcStart),--(QCDate<=wqcEnd)))"
.Offset(0, 5).Formula = "=IF(C" & .Row & "="""","""",IF(OR(E" & .Row & "=0,E" & .Row & "=""0""),""0%"",E" & .Row & "/D" & .Row & "))"
End With
End If
End Sub


This is what I have tried so far...

Sub replaceSummaryFormula()
Dim tg As Range
Dim colA As Range

With Worksheets("Summary")
Set colA = .Range("A2", .cells(.Rows.Count, "A").End(xlUp))
For Each tg In colA
If Not tg Is Nothing Then

Else
With tg
.Offset(0, 0).Formula = "=if(C" & .Row & "="""","""",C" & .Row & "&"" ""&B" & .Row & ")"
.Offset(0, 3).Formula = "=IF(C" & .Row & "="""","""",SUM(E" & .Row & ":F" & .Row & "))"
.Offset(0, 4).Formula = "=IF(C" & .Row & "="""","""",SUMPRODUCT(--(Techs=$C" & .Row & "),--(Pass=scan_pass),--(QCDate>=wqcStart),--(QCDate<=wqcEnd)))"
.Offset(0, 5).Formula = "=IF(C" & .Row & "="""","""",SUMPRODUCT(--(Techs=$C" & .Row & "),--(Fail=scan_fail),--(QCDate>=wqcStart),--(QCDate<=wqcEnd)))"
.Offset(0, 6).Formula = "=IF(C" & .Row & "="""","""",IF(OR(E" & .Row & "=0,E" & .Row & "=""0""),""0%"",E" & .Row & "/D" & .Row & "))"
End With
End If
Next tg
End With
End Sub
any ideas
Thank you in advance

Mark

mperrah
11-12-2007, 11:12 PM
Removed the else part of the If statement, it works,
but the worksheet seems to get stuck in a loop.

I think building an array to hold the row numbers with blanks,
then feed each array value to this sub in place of "tg".
Not sure how to set this up but I think the process might work.

With Worksheets("Summary")
Set colA = .Range("A2", .cells(.Rows.Count, "A").End(xlUp))
For Each tg In colA
If Not tg Is Nothing Then

' Else - removed
With tg

mperrah
11-12-2007, 11:56 PM
I got it from an xld post
I had to change the " & .row & " part for the formula to just " & (i) & "
but this works now.
If the user deletes the cell formula, I have a sub that will replace it.
This part adds the formula if I add data to the sheet,
so I don't have to keep the formula in rows that don't have data yet...

Sub AddSummaryFormula()
Dim i As Long
Dim iLastRow As Long

With Worksheets("Summary")
iLastRow = .cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
If .cells(i, "A").Value = "" Then
With .Range("A" & i)
.Offset(0, 0).Formula = "=if(C" & (i) & "="""","""",C" & (i) & "&"" ""&B" & (i) & ")"
.Offset(0, 3).Formula = "=IF(C" & (i) & "="""","""",SUM(E" & (i) & ":F" & (i) & "))"
.Offset(0, 4).Formula = "=IF(C" & (i) & "="""","""",SUMPRODUCT(--(Techs=$C" & (i) & "),--(Pass=scan_pass),--(QCDate>=wqcStart),--(QCDate<=wqcEnd)))"
.Offset(0, 5).Formula = "=IF(C" & (i) & "="""","""",SUMPRODUCT(--(Techs=$C" & (i) & "),--(Fail=scan_fail),--(QCDate>=wqcStart),--(QCDate<=wqcEnd)))"
.Offset(0, 6).Formula = "=IF(C" & (i) & "="""","""",IF(OR(E" & (i) & "=0,E" & (i) & "=""0""),""0%"",E" & (i) & "/D" & (i) & "))"
End With
End If
Next i
End With
End Sub

Bob Phillips
11-13-2007, 12:58 AM
M arvellous, I did nothing but I helped to solve it. There's influence <G>

Aussiebear
11-13-2007, 02:52 AM
I'd call it karma Bob

mperrah
11-13-2007, 09:57 AM
You guys have influenced most of what I can do.
It's like the force that binds us all together.
It is not as stong in me as with you, but a padawan I am.
Thank you for the apprenticeship.

Any force feed back on debloating.
I use 2007 to develope, but end users in 2002/2003 and can't upgrade.
I used the excel diet for 2003, but the larger work area in 2007 kill it (I think)

I'll try to shrink it enough to post.
Also 3 subs that copy and paste data really slow down.
addToDetail, addToArchive, and printQCForm.
Any ideas would be appreciated.

Thanks again.
Mark

exported as binary, then zipped, subs seem to work,
got zip down to 188k for transport.