CODEWITHSUNDEEP
excelvbaworksheet-function
SteveW1968
SteveW1968

Reputation: 23

Automatically copy formulas as data expands

HI all, I have large set of data that is updated twice weekly. The data set shrinks and grows continuosly. My problem is that, although it easy enough for me to manually delete or expand the formulas that make the data usable, i would like to automate the process. The formulas cover 10 columns.

OK - Need help, I just cant seem to get my head round Worksheet_change-please help.

The worksheet is named "data".

I am using Col A titled "task no" to base the expansion of the formulas on.

The formulas are in cols Y to AJ.

All i want is the formulas to expand themselves to last entry in row - sounds easy??????

By data currently cover 30,000 rows,

One other thing, the data is imported into the spreadsheet using a copy and paste macro, is this partly causing my problem?

Insert at 13.30

Here is what I have tried

Sheets("data").Select 

Bot = Range("A3").End(xlDown).Row 

Range("Y30000", "AJ30000").Select 

Range("Y30000", "AJ30000").Copy 

Selection.AutoFill Destination:=Range("Y30001" & Bot &, ":AJ30001" & Bot), 

Type:=xlFillDefault

Please help (Again)

Upvotes: 2

Views: 15128

Answers (2)

Tiago Cardoso
Tiago Cardoso

Reputation: 2107

I can think of two ways of doing it, one directly Excel and another using VBA.

Test Scenario:

Let's think we have columns A and B with variable data and then columns C and D with formulas (once you get the login behind the scenes, the amount of columns with formulas won't be important).

Besides, our formulas in column C are =A+B and in column D =A-B (C1=A1+B1, D1=A1-B1 and so on).

Excel:

  • Add into the formulas a test to check if there's any value in column A. If there's no value, we'll not put any information in the cell. Example: C1=IF(LEN(A1)>0,A1+B1,"") / D1 = =IF(LEN(A1)>0,A1-B1,""). Using this formula, you can copy the formula into the whole columns that nothing will be shown in case no data exists.
    • Pros: Easy to implement
    • Cons: The calculation time can take very long depending on your formulas

VBA:

  • You can implement a routine to update the formulas once the data changes in the sheet by using Worksheet_Change().
    • Pros: Requires a minimal VBA knowledge (almost none if a folk here in the SO build for you the code)
    • Cons: If you don't know VBA, you may depend on someone else to implement.

Hope it guide you to the solution of your problem!

Edit:

The VBA formula to do it would be like this...

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lCellCount As Long
    Dim lFormulaCount As Long
    Dim oWorkSheet As Excel.Worksheet
    Dim oRangeSource As Excel.Range
    Dim oRangeDest As Excel.Range

    'Define sheet
    Set oWorkSheet = Worksheets("Data")

    'Count how many entries we have in our dataset now
    lCellCount = oWorkSheet.Range("A1").End(xlDown).Row

    'Count how many formulas we have to proper delete
    lFormulaCount = WorksheetFunction.CountA(oWorkSheet.Columns("Y"))

    If lCellCount <> lFormulaCount Then

        'I assume we'll have at least one line in our report...
        If lFormulaCount > 2 Then oWorkSheet.Range("Y3:AJ" & lFormulaCount).ClearContents

        Set oRangeSource = oWorkSheet.Range("Y2:AJ2")
        Set oRangeDest = oWorkSheet.Range("Y2:AJ" & lCellCount)

        oRangeDest.Formula = oRangeSource.Formula

    End If

End Sub

Rgds

Upvotes: 2

tpascale
tpascale

Reputation: 2576

I think this snippet will help you. It presumes that you give a range name to the hdr cells preceding your data cols and formula cols resepectively (presumably the hdr row would never get deleted). Can be tweaked to handle other schemes for locating the ranges to operate on.

' DA1 = 1st data row, FR1 = first formula row
Dim rgDA1 As Range: Set rgDA1 = Range("HDR_ROW_FOR_DATA").Offset(1)
Dim rgFR1 As Range: Set rgFR1 = Range("HDR_ROW_FOR_FORMULAS").Offset(1)
Dim ws As Worksheet: Set ws = rgDA1.Worksheet

' define range rgDAT to cover ALL data rows, and define rgFRM w the same# rows
Dim rgDAT As Range: Set rgDAT = rgDA1.Resize(1 + ws.Rows.Count - rgDA1.Row)
                    Set rgDAT = Intersect(rgDAT, ws.UsedRange)
Dim rgFRM As Range: Set rgFRM = rgFR1.Resize(rgDAT.Rows.Count)

' now copy the 1st formula row to the other rows
rgFR1.Select
Selection.Copy
rgFRM.Select
ws.Paste
Application.CutCopyMode = False

Upvotes: 0

Related Questions