Filling formula for a wide range of cells.

[VKu]

Hi,

I need to put in functions/formula in a range of cells from C4:AEM121
With my reference cell being A4:A121 and another reference cell being C2:AEM2

for the first cell C4 the formula would be
=TR(C2,"TR.CompanyMarketCap","SDate=#1",,A4)

for the second cell C5 the formula would be
=TR(C2,"TR.CompanyMarketCap","SDate=#1",,A5)

for the first cell D4 the formula would be
=TR(D2,"TR.CompanyMarketCap","SDate=#1",,A4)

and so on. Please see attached file

I could fix the reference cell C2 by using $C$2, but I would have to do this for all the columns until the last column AME which is quite tedious.
Thus I'd like to know if there are any way to fill in the functions more easily and less time consuming, or perhaps a VBA macro could be used?


Thank you for suggestions and help.

Vku

[mehmetcik]

This is so easy.

Put all your formulas into one row of your spreadsheet.

Start the macro recorder and select each cell and the one below it in turn in turn, click on the formula and press enter.
stop the macro editor.

you will have something like:-

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("C4:C5").Select
    ActiveCell.FormulaR1C1 = _
        "=TR(R2C3,""TR.CompanyMarketCap"",""SDate=#1"",,RC[-2])"
    Range("C5").Select
End Sub

ou can edit that down to:-

Sub Macro1()

    Range("C4:C5").FormulaR1C1 = "=TR(R2C3,""TR.CompanyMarketCap"",""SDate=#1"",,RC[-2])"

End Sub

Once you have edited all your code you need two more things.

First to count the number of rows.

LR = Cells(rows.count,1).End(xlUp).Row

finds the last used row in column 1

LR = Cells(rows.count,2).End(xlUp).Row

finds the last used row in column 2

Finally use find / replace to replace

5")

with

" & LR )

Replacing all occurrences.

[VKu]

Thank you mehmetcik,

the code

Sub Macro1()
Range("C4").FormulaR1C1 = "=TR(R2C3,""TR.CompanyMarketCap"",""SDate=#1"",,RC[-2])"
End Sub

works well for the cell C4, but i'm not quite sure how to implement it to cover the whole range of cells.

could you please elaborate, i'm quite new to VBA

Many thanks!

Vku

[mehmetcik]

I get errors here.

so I cannot do it for you.

Range("C4:D5").FormulaR1C1 = "=TR(R2C3,""TR.CompanyMarketCap"",""SDate=#1"",,RC[-2])"

Will put that formula in 4 cells C4, C5, D4, D5


I have created this Macro to help you.


If you copy your recorded macro into column A of an excel spreadsheet and run this macro,

It will tidy up your macro for you.

Once its done its job, copy the macro back to visual basic.

Sub VB_Editor()

On Error Resume Next

DeleteAllArray = Array("'", "Application.CutCopyMode = False")
DeletePartArray = Array("ActiveWindow.ScrollRow", "ActiveWindow.SmallScroll", "ActiveWindow.LargeScroll")
Application.CutCopyMode = False

LR = Sheets(1).UsedRange.Rows.Count

'Sort Empty Rows to the bottom
    Range("B1:B" & LR).FormulaR1C1 = "=IF(RC[-1]="""","""",ROW())"
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1:B" & LR), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:B" & LR)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

For Count = 0 To UBound(DeleteAllArray)

10 ' DeleteAllArray
Range("A" & Pos & ":A" & Sheets(1).UsedRange.Rows.Count).Select
Selection.Find(What:=DeleteAllArray(Count), After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
        
If InStr(ActiveCell.Value, DeleteAllArray(Count)) = 0 Then GoTo 20

If Left(ActiveCell.Value, Len(strValueToPick)) = strValueToPick Then ActiveCell.EntireRow.Delete

GoTo 10

20  Next Count


LR = Sheets(1).UsedRange.Rows.Count

For Count = 0 To UBound(DeletePartArray)
Pos = 1

30 ' DeletePartArray
Range("A" & Pos & ":A" & Sheets(1).UsedRange.Rows.Count).Select
Selection.Find(What:=DeletePartArray(Count), After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
        
If InStr(ActiveCell.Value, DeletePartArray(Count)) = 0 Then GoTo 40

If Left(ActiveCell.Value, DeletePartArray(Count)) = DeletePartArray(Count) Then ActiveCell.EntireRow.Delete

GoTo 30

40  Next Count

'Delete     ActiveCell.FormulaR1C1 = _

50  Range("A" & Pos & ":A" & Sheets(1).UsedRange.Rows.Count).Select
Selection.Find(What:="ActiveCell.FormulaR1C1 = _", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
        
If InStr(CStr(ActiveCell.Value), "ActiveCell.FormulaR1C1 = _") = 0 Then Pos = 1: GoTo 60

ActiveCell.Value = "ActiveCell.FormulaR1C1 = " & ActiveCell.Offset(1, 0).Value
Rows(ActiveCell.Row + 1 & ":" & ActiveCell.Row + 1).EntireRow.Delete
GoTo 50

60 ' Get rid of Select followed by select


Range("A" & Pos & ":A" & Sheets(1).UsedRange.Rows.Count).Select
Selection.Find(What:=".Select", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
        
If InStr(CStr(ActiveCell.Value), "Select") = 0 Then GoTo 70
Pos = ActiveCell.Row
T1 = Left(Application.Trim(Cells(Pos, 1).Value), 5)
T2 = Right(Cells(Pos, 1).Value, 6)
T3 = Left(Cells(Pos + 1, 1).Value, 5)
T4 = Right(Cells(Pos + 1, 1).Value, 6)

If Left(Application.Trim(Cells(Pos, 1).Value), 5) = "Range" And Right(Application.Trim(Cells(Pos, 1).Value), 6) = "Select" And Left(Application.Trim(Cells(Pos + 1, 1).Value), 5) = "Range" And Right(Application.Trim(Cells(Pos + 1, 1).Value), 6) = "Select" Then
Rows(Pos & ":" & Pos).EntireRow.Delete: Pos = Pos - 1
End If
Pos = Pos + 1: GoTo 60


70  ' Simplify Range Select Formula Fill.
LR = Sheets(1).UsedRange.Rows.Count
For Count = LR - 2 To 1 Step -1

If Left(Application.Trim(Cells(Count, 1).Value), 5) = "Range" And Right(Application.Trim(Cells(Count, 1).Value), 6) = "Select" And _
Left(Application.Trim(Cells(Count + 1, 1).Value), 23) = "Selection.FormulaR1C1 =" Then

Cells(Count, 1).Value = Left(Cells(Count, 1).Value, Len(Cells(Count, 1).Value) - 6) & Right(Application.Trim(Cells(Count + 1, 1).Value), Len(Application.Trim(Cells(Count + 1, 1).Value)) - 10)
Rows(Count + 1).EntireRow.Delete
End If

If Left(Application.Trim(Cells(Count, 1).Value), 5) = "Range" And Right(Application.Trim(Cells(Count, 1).Value), 6) = "Select" And _
Left(Application.Trim(Cells(Count + 1, 1).Value), 24) = "ActiveCell.FormulaR1C1 =" Then

Cells(Count, 1).Value = Left(Cells(Count, 1).Value, Len(Cells(Count, 1).Value) - 6) & Right(Application.Trim(Cells(Count + 1, 1).Value), Len(Application.Trim(Cells(Count + 1, 1).Value)) - 11)
Rows(Count + 1).EntireRow.Delete
End If

Next

End Sub