Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Copy down formulas using vba 1

Status
Not open for further replies.

smurf01

IS-IT--Management
Jul 6, 2002
470
GB
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") 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
 
Hi,

Here is an example of what can be done...
Code:
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
 
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:D"].Column), Cells(.Row + .Rows.Count - 1, ["A:D"].Column)).Formula = Cells(3, ["A:D"].Column).Formula
End With
End Sub

Regards

Paul
 
try this
Code:
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
 
Skip, code works but, when i run it it changes the formula in A3. At the moment the formulas in A3:D3 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
 
That's 'cuz ActiveSheet.UsedRange.Row is probably not 3.

Start the destination range in row 3
Code:
        Range(Cells(3, &quot;A&quot;), Cells(.Row + .Rows.Count - 1, &quot;D&quot;)).Formula =


Skip,
Skip@TheOfficeExperts.com
 
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
 
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
Code:
Application.EnableEvents = False
'... your macro call
Application.EnableEvents = True
:)

Skip,
Skip@TheOfficeExperts.com
 
Skip,
Thats great thanks again [2thumbsup] [2thumbsup] [wavey2]

Regards

Paul
 
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
Code:
With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    With Selection.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
    Range(&quot;A3&quot;).Select
'This sets the formulas for the cells in row 3
Code:
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
Code:
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

[ponder] [ponder]


Regards

Paul
 
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.
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
Private Sub cmdCopyFormula_Click()
    FormatSheet
End Sub
Hope this helps :)


Skip,
Skip@TheOfficeExperts.com
 
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
 
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...
Code:
Sub StickSheetName()
  With ActiveSheet
    Select Case .Name
      Case &quot;Sheet4&quot;
        [A1].Value = .Name & &quot; &quot; & 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
 
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. [medal] [medal]



Regards

Paul
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top