Copy down formulas using vba 1

[smurf01]

I have some sheets related to thread707-684845 that SkipVought has helped me with, what i need to do now is the following,

I have data in each row from columns ("A:M) and the rows may vary, in columns ("N:Q&quot I have formulas that relate to data in columns I and H. I have tried using Tools/Options/Edit/"Extend list formats and formulas" but this does not seem to work due to the fact that the columns that hold the data are not adjacent to the columns containing the formulas.

Is it possible to write some code that will do this for me.


Regards

Paul

 

[SkipVought]

Hi,

Here is an example of what can be done...

Sub CopyFormula()
    With ActiveSheet.UsedRange
        Range(Cells(.Row, [Selection].Column), Cells(.Row + .Rows.Count - 1, [Selection].Column)).Formula = Cells(1, [Selection].Column).Formula
    End With
End Sub

where selection is the column having a formula in row 1 (change the row where the formula is to suite your situation)

Hope this helps

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[smurf01]

Skip,
I know I've probably got this wrong but when I try to run this code i get the message "object required"

Sub CopyFormula()
With ActiveSheet.UsedRange
Range(Cells(.Row, ["A"].Column), Cells(.Row + .Rows.Count - 1, ["A"].Column)).Formula = Cells(3, ["A"].Column).Formula
End With
End Sub

Regards

Paul

 

[SkipVought]

try this

Sub CopyFormula()
    With ActiveSheet.UsedRange
        Range(Cells(.Row, "A"), Cells(.Row + .Rows.Count - 1, "D")).Formula = Range(Cells(3, "A"), Cells(3, "D")).Formula     
    End With
End Sub

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[smurf01]

Skip, code works but, when i run it it changes the formula in A3. At the moment the formulas in A33 is as follows

A3) =IF(E3<>&quot;&quot;,IF(M3=&quot;YES&quot;,1,0))
B3) =IF(E3<>&quot;&quot;,IF(M3=&quot;NO&quot;,1,0))
C3) =IF(E3<>&quot;&quot;,IF(OR(L3>0,L3=&quot;&quot,0,1))
D3) =IF(E3<>&quot;&quot;,IF(L3>0,1,0))

After I run the code it changes to

A3) =IF(E5<>&quot;&quot;,IF(M5=&quot;YES&quot;,1,0))
B3) =IF(E5<>&quot;&quot;,IF(M5=&quot;NO&quot;,1,0))
C3) =IF(E5<>&quot;&quot;,IF(OR(L5>0,L5=&quot;&quot,0,1))
D3) =IF(E5<>&quot;&quot;,IF(L5>0,1,0))


And then every row under that is also 2 rows out, also on the sheet i am testing the last row containing data is row 92, yet it kept filling in the column right down to row 892

Regards

Paul

 

[SkipVought]

That's 'cuz ActiveSheet.UsedRange.Row is probably not 3.

Start the destination range in row 3

        Range(Cells(3, "A"), Cells(.Row + .Rows.Count - 1, "D")).Formula =

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[smurf01]

Skip, Sorry you are absolutely right as usual, I missed that when i was looking at the data. Code is working absolutely fine now

Again please accept my thanks for your help and patience, it cannot be easy when the requestor is not sure what he is doing.

Could you suggest the best method to use the code, i.e. Selection_Change for example. I would like the code to run after I have pasted my data into the appropiate cells

Anyway a star for you

Regards

Paul

 

[SkipVought]

You don't want Worksheet_SelectionChange, you want Worksheet_Change event.

The problem comes when the macro you run from Worksheet_Change changes the worksheet. That will cause recusive calls to your macro and you'll run outta memory QUIK!

So your Worksheet_Change sub needs to be

Application.EnableEvents = False
'... your macro call
Application.EnableEvents = True

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[smurf01]

Skip,
Thats great thanks again

Regards

Paul

 

[smurf01]

Skip, bet you thought you had got rid of me (HA! HA!)

The code you helped me with works great but at the moment I have a command button on each of my worksheets and the code set up in each worksheet. Is it possible to only have the code once in my workbook and that the command button runs the code on the correct sheet by the use of ActiveSheet.(&quot;Sheetname&quot

The code I am using is pasted below I have added to it as when I paste from the access query including the field headers (I have not been able to find a way of copying data from access with the field headers being included) it changes the Excel formatting so I have added code to change it back, also i have added code to set the initial formulas in the Cells on row 3 as I found that if the entire row was deleted then I lost the initial formulas


Private Sub cmdCopyFormula_Click()
Rows(&quot;2:2&quot.Select
'This sets the format for the row headers

With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    Range("A3").Select

'This sets the formulas for the cells in row 3

Cells(3, 14).Formula = "=IF(I3=""YES"",1,0)"
Cells(3, 15).Formula = "=IF(I3=""NO"",1,0)"
Cells(3, 16).Formula = "=IF(H3>0,0,1)"
Cells(3, 17).Formula = "=IF(H3>0,1,0)"

'This is your code for copying the formulas down

With ActiveSheet.UsedRange
        Range(Cells(3, "N"), Cells(.Row + .Rows.Count - 1, "Q")).Formula = Range(Cells(3, "N"), Cells(3, "Q")).Formula
    End With
End Sub

Regards

Paul

 

[SkipVought]

Paul,

Try to minimize Selecting and Activating.

In your case, you will be executing FormatSheet from the a command button click event on a sheet that is the ActiveSheet. This way each command button click event calls the FormatSheet procedure in a separate module.

Sub FormatSheet()
    'This sets the format for the row headers
    With Rows("2:2")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        With .Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 1
        End With
    End With
'This sets the formulas for the cells in row 3
    Cells(3, 14).Formula = "=IF(I3=""YES"",1,0)"
    Cells(3, 15).Formula = "=IF(I3=""NO"",1,0)"
    Cells(3, 16).Formula = "=IF(H3>0,0,1)"
    Cells(3, 17).Formula = "=IF(H3>0,1,0)"
'This is your code for copying the formulas down
    With ActiveSheet.UsedRange
            Range(Cells(3, "N"), Cells(.Row + .Rows.Count - 1, "Q")).Formula = Range(Cells(3, "N"), Cells(3, "Q")).Formula
    End With
End Sub
Private Sub cmdCopyFormula_Click()
    FormatSheet
End Sub

Hope this helps


Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[SkipVought]

faq707-4105 How Can I Make My Code Run Faster?

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[smurf01]

Skip, have i got this straight what you are saying is create a module called FormatSheet()containing the following code

Sub FormatSheet()
'This sets the format for the row headers
With Rows(&quot;2:2&quot
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
With .Font
.Name = &quot;Arial&quot;
.FontStyle = &quot;Regular&quot;
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
End With
'This sets the formulas for the cells in row 3
Cells(3, 14).Formula = &quot;=IF(I3=&quot;&quot;YES&quot;&quot;,1,0)&quot;
Cells(3, 15).Formula = &quot;=IF(I3=&quot;&quot;NO&quot;&quot;,1,0)&quot;
Cells(3, 16).Formula = &quot;=IF(H3>0,0,1)&quot;
Cells(3, 17).Formula = &quot;=IF(H3>0,1,0)&quot;
'This is your code for copying the formulas down
With ActiveSheet.UsedRange
Range(Cells(3, &quot;N&quot, Cells(.Row + .Rows.Count - 1, &quot;Q&quot).Formula = Range(Cells(3, &quot;N&quot, Cells(3, &quot;Q&quot).Formula
End With
End Sub

Then call that module from the relevant command button containing the following code

Private Sub cmdCopyFormula_Click()
FormatSheet
End Sub



Regards

Paul

 

[SkipVought]

Paul,

If you have multiple sheets that use identical code or near identical code with differences based on sheet name, then a button on each sheet can run the same code.

Take, for instance, this simple code that puts the sheet name in A1, but on Sheet4, also inserts the Worksheet count...

Sub StickSheetName()
  With ActiveSheet
    Select Case .Name
      Case "Sheet4"
        [A1].Value = .Name & " " & Worksheets.Count
      Case Else
        [A1].Value = .Name
    End Select
  End With
End Sub

Then any sheet could have a button to execute StickSheetName. And you could do other sheet-specific processing using the Select Case construct.



Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[smurf01]

Skip, thanks for the info, I have created a module call FormatSheet and placed the code into it, then I added the code FormatSheet to my worksheet buttons and Everything is working Fine. The info you posted in your last Post will stand me in good stead for future use of identical or near identical code.

I wish I could give you another &quot;star&quot; for all the info and help you have given me, but you will have to do with a couple of medals.



Regards

Paul