PDA

View Full Version : Place formulas by criteria VBA



Shazam
01-07-2006, 03:10 PM
Hi everyone,

I have this code below that if a cell in column C has the word:
"NCR1 Grand Total" it will place the formula in column X that coresponds to the word in column C. I also want to look for these words as well and place the formulas in coulmn X:

"OCR1 Grand Total"

"NCR2 Grand Total"

But it only works to a certain point. Because I download this file from a database daily so I need to run this code daily. My data fluctuates daily. The hard thing about it is to have the ranges of the formulas to stay in by shifts. Please look at the ranges of the formulas. I attach the workbook below it will give you a better explanation. If someone could modified this code to suite my needs that will be great.

Thanks!: pray2:



Sub Place_Formula()
Dim C As Range
With ActiveSheet.Columns("C:C")
Set C = .Find("NCR1 Grand Total", LookIn:=xlValues, lookat:=xlWhole)
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.Offset(0, 16).Formula = "=SUMPRODUCT(1-SUBTOTAL(3,OFFSET(R[-65]C:R[-1]C," & _
"ROW(R[-65]C:R[-1]C)-ROW(R[-65]C),0,1)),--(R[-65]C:R[-1]C>0),R[-65]C:R[-1]C)"
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
End Sub

Ken Puls
01-07-2006, 03:46 PM
Hi Shazam,

I haven't actually looked at your data file, but conceptually, couldn't you do the following?

Instead of looking for NCR1 Grand Total, OCR1 Grand Total, etc..., how about looking for "Grand Total"

Then when you find it, run a Case statment inside your loop:
Do
Select Case Left(c.value)
Case Is = "NCR1"
'do your Sumproduct
Case Is = "OCR1"
'do something else
Case Is = "NCR2"
'do something different
End Select
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress

If not, I'll try to look at your data a little later.

HTH,

Shazam
01-07-2006, 03:54 PM
Hi Shazam,

I haven't actually looked at your data file, but conceptually, couldn't you do the following?

Instead of looking for NCR1 Grand Total, OCR1 Grand Total, etc..., how about looking for "Grand Total"

Then when you find it, run a Case statment inside your loop:
Do
Select Case Left(c.value)
Case Is = "NCR1"
'do your Sumproduct
Case Is = "OCR1"
'do something else
Case Is = "NCR2"
'do something different
End Select
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress

If not, I'll try to look at your data a little later.

HTH,



Thank You for responding.

It would work if my data was set. But I transfer the data from a database daily and my data fluctuates daily so the formulas ranges are different everytime. If somehow the code could place the formulas in the their right destination according by shifts that will be great.

What do you think?

TonyJollans
01-07-2006, 04:31 PM
Hi Shazam,

From a quick look your formula is not affected by the inclusion of extra blank cells in the Ranges so could you perhaps do something like this ..

Sub Place_Formula()
Dim C As Range
Dim R1 As Long
R1 = 3
With ActiveSheet.Columns("C:C")
Set C = .Find("Grand Total", LookIn:=xlValues, lookat:=xlPart)
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.Offset(0, 16).Formula = "=SUMPRODUCT(1-SUBTOTAL(3,OFFSET(R" & R1 & "C:R[-1]C," & _
"ROW(R" & R1 & "C:R[-1]C)-ROW(R" & R1 & "C),0,1)),--(R" & R1 & "C:R[-1]C>0),R" & R1 & "C:R[-1]C)"
R1 = C.Row + 1
Set C = .FindNext(C)
Loop While C.Address <> firstAddress
End If
End With
End Sub

Note you would need to do this in one pass so I have incorporated Ken's suggestion (except I haven't added the Case construct because I don't know what to do for the different cases).

If the blank cells do make a difference then you would need a little more complex logic to find the start row each time but, in principle, it should still be possible.

Ken Puls
01-07-2006, 04:43 PM
LOL!

I was just popping back in to say that I'd try to get to it a little later when I had more time. Thanks for covering me, Tony!

:)

TonyJollans
01-07-2006, 05:17 PM
My pleasure - just hope it works. I'm not doing much Excel these days and it's easy to forget :)

Shazam
01-07-2006, 05:17 PM
Thanks Tony!


It works great. Also the blanks cells well I'm not sure I dont think it will be a problem. I will have talk to the engineers on monday to see if will cause them any problems because I know they do there analiyis in those blank cells using other Subtotal formulas, maybe I could swayed them doing the next column over. Once again thank you very much Tony.