Using a formula in a range of cells - vba

I want to use a formula in a range of cells but I get the formula in that cell and not the results of the formula.
I tried a couple of different ways.
The first script I tried entered the formula all the way down the column until the last row value: -
Dim LastRow As Long
LastRow = Cells(Rows.Count, 5).End(xlUp).Row
Range("DO22:DO" & LastRow).Formula = "IF=COUNTIF(AS22:AU" & LastRow & " ,""=Major Variance"")>0,""Major Variance"",IF(COUNTIF(AS22:AU" & LastRow & " ,""=Minor Variance"")>0,""Minor Variance"",""On Track""))"
This is the other script I tried but this puts the formula only in the first row of the range: -
Dim LastRow As Long
Dim Rng As Range
Range("DO22:DO" & LastRow).Select
For Each Rng In Range("DO22:DO" & LastRow)
ActiveCell.Formula = "IF=COUNTIF(AS22:AU" & LastRow & " ,""=Major Variance"")>0,""Major Variance"",IF(COUNTIF(AS22:AU" & LastRow & " ,""=Minor Variance"")>0,""Minor Variance"",""On Track""))"
Next Rng
Edit 1
I have made a change to the code as per someone's answer but I am now getting an run-time error 'Application-defined or object defined error.
It only seems to happen when I add the extra = in front of the If. The error appears on the line
Rng.Formula = "=IF=COUNTIF(AS22:AU" & LastRow & " ,""=Major Variance"")>0,""Major Variance"",IF(COUNTIF(AS22:AU" & LastRow & " ,""=Minor Variance"")>0,""Minor Variance"",""On Track""))"
Here is the edited script: -
Dim Rng As Range
Dim LastRow As Long
LastRow = Cells(Rows.Count, 5).End(xlUp).Row
Range("DO22:DO" & LastRow).Select
For Each Rng In Range("DO22:DO" & LastRow).Cells
Rng.Formula = "=IF=COUNTIF(AS22:AU" & LastRow & " ,""=Major Variance"")>0,""Major Variance"",IF(COUNTIF(AS22:AU" & LastRow & " ,""=Minor Variance"")>0,""Minor Variance"",""On Track""))"
Rng.Value = Rng.Value
Next Rng

You have a malformed IF function and COUNTIF function.
'target formula "=IF(COUNTIF(AS22:AU99, "Major Variance"), "Major Variance", =IF(COUNTIF(AS22:AU99, "Minor Variance"), "Minor Variance", "On Track"))
rng.Formula = "=IF(COUNTIF(AS22:AU" & lastRow & ", ""Major Variance""), ""Major Variance"", " & _
"IF(COUNTIF(AS22:AU" & lastRow & ", ""Minor Variance""), ""Minor Variance"", " & _
"""On Track""))"
rng = rng.Value
Note that if both Major Variance and Minor Variance exist, then Major Variance takes precedence.
To put this formula into each row and modify the row each time in a loop, the code would look like this.
Dim lastRow As Long, rng As Range
With Worksheets("Sheet1") '<~~ you should know what worksheet you are on!
lastRow = .Cells(Rows.Count, 5).End(xlUp).Row
For Each rng In .Range("DO22:DO" & lastRow)
rng.Formula = "=IF(COUNTIF(AS" & rng.Row & ":AU" & rng.Row & ", ""Major Variance""), ""Major Variance"", " & _
"IF(COUNTIF(AS" & rng.Row & ":AU" & rng.Row & ", ""Minor Variance""), ""Minor Variance"", " & _
"""On Track""))"
rng.Value = rng.Value
Next rng
End With
But you can also put the formula into all of the cells at once like this.
Dim lastRow As Long
With Worksheets("Sheet1") '<~~ you should know what worksheet you are on!
lastRow = .Cells(Rows.Count, 5).End(xlUp).Row
With .Range("DO22:DO" & lastRow)
.Formula = "=IF(COUNTIF(AS22:AU22, ""Major Variance""), ""Major Variance"", " & _
"IF(COUNTIF(AS22:AU22, ""Minor Variance""), ""Minor Variance"", " & _
"""On Track""))"
.Value = .Value
End With
End With

You are using activecell in the 2nd one so it will only be in the active cell if not selected. so you need to change your loop to be
For Each Rng In Range("DO22:DO" & LastRow).cells
and then
rng.Formula = "=IF=COUNTIF(AS22:AU" & LastRow & " ,""=Major Variance"")....
then
rng.value=rng.value
also, in the 2nd one, youre not setting LastRow.

Related

vba to sort the data into matrix form

I have some data, for the first column date, it contains two dates.
Then I have the fund code and the categories, the last column is the categories value.
How shall I put them into matrix format, for example, the categories is horizontal and the value correspond to the fund name and categories and the date.
Following code should be helpful.
Option Explicit
Sub Demo()
With Application
.ScreenUpdating = False 'stop screen flickering
.Calculation = xlCalculationManual 'prevent calculation while execution
End With
Dim i As Long, lastrow As Long, tblLastRow As Long, tblLastColumn As Long
Dim dict As Object
Dim rng As Variant
Dim ws As Worksheet
Dim cel As Range, dateRng, fundCodeRng As Range, categoryRng As Range, valueRng As Range
Set dict = CreateObject("Scripting.Dictionary")
Set ws = ThisWorkbook.Worksheets("Sheet1") 'change Sheet1 to your worksheet
With ws
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row 'get last row with data
'set ranges for date, fund code, category and value to be used later in code
Set dateRng = .Range("A2:A" & lastrow)
Set fundCodeRng = .Range("B2:B" & lastrow)
Set categoryRng = .Range("C2:C" & lastrow)
Set valueRng = .Range("D2:D" & lastrow)
'get unique records for date and fund coding combined together
For i = 2 To lastrow
dict(.Cells(i, 1).Value & "|" & .Cells(i, 2).Value) = dict(.Cells(i, 1).Value & "|" & .Cells(i, 2).Value)
Next
With .Range("F2").Resize(dict.Count) 'date and fund code will be displayed from cell F2
.Value = Application.Transpose(dict.Keys)
.TextToColumns Destination:=.Cells, DataType:=xlDelimited, Other:=True, OtherChar:="|"
.Offset(, 2).Resize(dict.Count).Value = Application.Transpose(dict.Items)
End With
'empty dictionary
dict.RemoveAll
Set dict = Nothing
Set dict = CreateObject("Scripting.Dictionary")
'get unique categories and display as header
rng = .Range("C1:C" & lastrow)
For i = 2 To UBound(rng)
dict(rng(i, 1) & "") = ""
Next
.Range("H1").Resize(1, UBound(dict.Keys()) + 1).Value = dict.Keys 'categories will be displayed from column H
tblLastRow = .Range("F" & Rows.Count).End(xlUp).Row 'get last row in new table
tblLastColumn = Cells(1, Columns.Count).End(xlToLeft).Column 'get last column of category in new table
'display corresponding values for date, fund code and category
For Each cel In .Range(.Cells(2, 8), .Cells(tblLastRow, tblLastColumn)) 'Cells(2, 8) represent Cell("H2")
cel.FormulaArray = "=IFERROR(INDEX(" & valueRng.Address & ",MATCH(1,(" & dateRng.Address & "=" & .Cells(cel.Row, 6) & ")*(" & fundCodeRng.Address & "=""" & .Cells(cel.Row, 7) & """)*(" & categoryRng.Address & "=""" & .Cells(1, cel.Column) & """),0)),"""")"
cel.Value = cel.Value
Next cel
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
See image for reference.
EDIT :
If Fund Code could be numbers also then replace
cel.FormulaArray = "=IFERROR(INDEX(" & valueRng.Address & ",MATCH(1,(" & dateRng.Address & "=" & .Cells(cel.Row, 6) & ")*(" & fundCodeRng.Address & "=""" & .Cells(cel.Row, 7) & """)*(" & categoryRng.Address & "=""" & .Cells(1, cel.Column) & """),0)),"""")"
with
cel.FormulaArray = "=IFERROR(INDEX(" & valueRng.Address & ",MATCH(1,(" & dateRng.Address & "=" & .Cells(cel.Row, 6) & ")*(Text(" & fundCodeRng.Address & ",""0"")=""" & .Cells(cel.Row, 7) & """)*(" & categoryRng.Address & "=""" & .Cells(1, cel.Column) & """),0)),"""")"

vba to copy to different ranges

I have this sheet called Consulta where everytime I change the value on the column K it changes the color of the range E:K to green or white if it's empty.
I also want to if the row is green, copy that row to the sheet called E-mail. This is what I've tried so far and it works:
Sub ChangeColor()
Dim ws As Worksheet, ws1 As Worksheet, i As Long, lastrow As Long
Set ws = Sheets("Consulta")
Set ws1 = Sheets("E-mail")
lastrow = ws.Cells(Rows.Count, "E").End(xlUp).Row
For i = 5 To lastrow
If ws.Range("K" & i) <> "" Then
ws.Range("E" & i & ":K" & i).Interior.ColorIndex = 43
ws.Range("E" & i & ":K" & i).Copy ws1.Range("A" & i & ":G" & i)
Else
ws.Range("E" & i & ":K" & i).Interior.ColorIndex = 2
End If
Next
If ws.Range("E" & i & ":K" & i).Interior.ColorIndex = 2 Then
ws1.Range("A" & i & ":G" & i).Clear
End If
End Sub
My problem is with this line below:
ws.Range("E" & i & ":K" & i).Copy ws1.Range("A" & i & ":G" & i)
I actually want to copy to a different range instead of the corresponding range in the sheet E-mail (for example, if the first match is E3:K3 I want to copy to A2:K2. If the second match is E34:K34 I want to copy it to A3:K3 and so it goes).
I tried using another loop but my Excel got crazy so I think I did it wrong.
Any suggestions will be appreciated.
You only need the upper-left corner cell for a destination. Look from the bottom up for the last used cell and offset down a row.
with ws1
ws.Range("E" & i & ":K" & i).Copy .cells(.rows.count, "A").end(xlup).offset(1, 0)
end with
You might want to put this above the line that applies a fill color or you will be copying the fill color as well.

Insert formula with Variable VBA

I'm trying to insert a formula in the Column C of Sheet2. The row number however depends on the value of pasterow. The range in the formula should be G[lastrow]:NS[lastrow] with lastrow pertaining to the last row of Sheet1.
Here is my code:
Sub try()
With Sheets("Sheet2")
pasterow = .Cells(.rows.Count, "B").End(xlUp).Offset(1, 0).Row
With Sheets("Sheet1")
lastRow = ActiveWorkbook.Worksheets("Sheet1").Range("F" & .rows.Count).End(xlUp).Row
ActiveWorkbook.Worksheets("Sheet2").Range("C" & pasterow).formula = _
"=COUNTIF(Sheet1!G & lastRow & :NS & lastRow & , ""VL"" )"
End With
End With
End Sub
I'll really appreciate if someone could point out what's wrong with my code. Thanks!
The VBA variables are inside your formula string. Compare:
ActiveWorkbook.Worksheets("Sheet2").Range("C" & pasterow).formula = "=COUNTIF(Sheet1!G" & lastrow & ":NS" & lastrow & ", ""VL"" )"
Try this..
ActiveWorkbook.Worksheets("Sheet2").Range("C" & pasterow).FormulaR1C1 = "=COUNTIF(Sheet1!C[4]:C[380],""VL"")"
May be this is what your expecting to achieve!
ActiveWorkbook.Worksheets("Sheet2").Range("C" & pasterow).Value = "=COUNTIF(Sheet1!G" & lastRow & ":NS" & lastRow & ", ""VL"" )"
Try with:
ActiveWorkbook.Worksheets("Sheet2").Range("C" & pasterow).formula = _
"=COUNTIF(Sheet1!R" & lastrow & "C7:R" & lastrow & "C383,""VL"")"

Using String Variable in VBA Formula throwing object/application error

I'm getting an "application-defined or object-defined error" being thrown when I try to set a cell in my active sheet to a formula. I think its due to me trying to use the Sheets.Name function in the formula, see code below:
Public Sub getChannels()
Dim lastRow As Long
Dim i As Integer, counter As Integer
Dim rng As Range, rngB As Range, rngC As Range
Dim sht As Worksheet
Dim test As String
Set sht = Sheets("Summary Sheet - 30-07-2015")
sht.Activate
lastRow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
For counter = 1 To lastRow Step 3
If ActiveSheet.Cells(counter, 12) = "LTE 2C" Then
ActiveSheet.Cells(counter, 16) = _
"=INDEX('LTE 2C'!C[55],MATCH(""'"" & sht.name &""'""!RC[-14],'LTE 2C'!C[-11],0))"
ActiveSheet.Cells(counter, 17) = _
"=INDEX('LTE 2C'!C[53],MATCH(""'"" & sht.name &""'""!RC[-15],'LTE 2C'!C[-12],0))"
ActiveSheet.Cells(counter, 18) = _
"=INDEX('LTE 2C'!C[55],MATCH(""'"" & sht.name &""'""!RC[-16],'LTE 2C'!C[-13],0))"
Range("P" & counter & ":R" & counter).Select
Selection.Copy
Range("P" & counter + 1 & ":P" & counter + 2).Select
ActiveSheet.Paste
End If
Next
End Sub
Am I missing something obvious?
Change your formula like this:
ActiveSheet.Cells(counter, 16) = _
"=INDEX('LTE 2C'!C[55],MATCH(" & "'" & sht.name & "'" & "!RC[-14],'LTE 2C'!C[-11],0))"
ActiveSheet.Cells(counter, 17) = _
"=INDEX('LTE 2C'!C[53],MATCH(" & "'" & sht.name & "'" & "!RC[-15],'LTE 2C'!C[-12],0))"
ActiveSheet.Cells(counter, 18) = _
"=INDEX('LTE 2C'!C[55],MATCH(" & "'" & sht.name & "'" & "!RC[-16],'LTE 2C'!C[-13],0))"
Nelly is correct, but another way to do this would be to simply remove the unnecessary extra string for each apostrophe and replace it with this:
ActiveSheet.Cells(counter, 16) = _
"=INDEX('LTE 2C'!C[55],MATCH('" & sht.name & "'!RC[-14],'LTE 2C'!C[-11],0))"
Where the apostrophes are just attached to the strings before and after. It really makes no difference, but it removes the extra (&)s.

Use the last row count in a formula

The following code allows me to repeat a formula from row 2 to all rows up to the last active row.
Dim LastRow As Long
With Sheets("C PUR TYPE")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("M2:M" & LastRow).formula = "=IFERROR(RIGHT(SUBSTITUTE(Lookup_concat(A2,$A$2:$A1932,$L$2:$L1932),"" 0,"",""""),LEN(SUBSTITUTE(Lookup_concat(A2,$A$2:$A1932,$L$2:$L1932),"" 0,"",""""))-2),"" - "")"
End With
In this instance there are 1'932 active rows.
Is there a way that I can replace the cell reference :$A1932 and $L1932 in the formula to using the last row count as the row count will be different each time the report runs.
Thanks
Using & will allow you to concatenate the variable into the string:
Dim LastRow As Long
With Sheets("C PUR TYPE")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("M2:M" & LastRow).formula = "=IFERROR(RIGHT(SUBSTITUTE(Lookup_concat(A2,$A$2:$A" & LastRow & ",$L$2:$L" & LastRow & "),"" 0,"",""""),LEN(SUBSTITUTE(Lookup_concat(A2,$A$2:$A" & LastRow & ",$L$2:$L" & LastRow & "),"" 0,"",""""))-2),"" - "")"
End With
Seems to me like you can use a variable similar to how you calculated lastRow.
Example (assuming you don't have any blanks in column A):
dim LookupLastrow as long
LookupLastrow=range("A1").end(xldown).row
then replace the 1932 references in your formula with " & lookuplastrow & ":
.Range("M2:M" & LastRow).formula = "=IFERROR(RIGHT(SUBSTITUTE(Lookup_concat(A2,$A$2:$A" & lookuplastrow & ",$L$2:$L" & lookuplastrow & "),"" 0,"",""""),LEN(SUBSTITUTE(Lookup_concat(A2,$A$2:$A" & lookuplastrow & ",$L$2:$L" & lookuplastrow & "),"" 0,"",""""))-2),"" - "")"