Averaging different length ranges in excel with VBA - excel

I'm trying to write a short macro that includes a line that averages a range of cells. In each worksheet that I want to run the macro in the range of cells is a different length.
After running the macro the cell E1 contains "=AVERAGE(Rng)"
Dim homeSheet As Worksheet
Set homeSheet = ActiveSheet
Dim lastRow As Long
Dim Rng As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("B2:B" & lastRow)
Range("E1").Formula = "=Average(Rng)"
Range("E2").Formula = "=STDEV(Rng)"
Range("E3").Select
ActiveWindow.SmallScroll Down:=-2
End Sub
I've also tried
Range("E1").Formula = "=Average(Range("B2:B" & lastRow))"
without trying to use Set Rng = Range("B2:B" & lastRow)

You need to use Rng.Address in your formulas. Try to change your code into this:
Sub Avg()
Dim homeSheet As Worksheet
Set homeSheet = ActiveSheet
Dim lastRow As Long
Dim Rng As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("B2:B" & lastRow)
Range("E1").Formula = "=Average(" & Rng.Address & ")"
Range("E2").Formula = "=STDEV(" & Rng.Address & ")"
Range("E3").Select
End Sub
If you were to use the second method you have tried, you would need to change that line of code to:
Range("E1").Formula = "=Average(" & Range("B2:B" & lastRow).Address & ")"

Related

COUNTIFS formula to refer to a dynamic range in another sheet from the active sheet

I am trying to incorporate this COUNTIFS formula into a worksheet via VBA but cannot seem to get it to work and with my rather limited VBA skills I've hit a bit of a brick wall.
This is the formula I want to incorporate but I want the range to be dynamic rather than fixed:
=IF(COUNTIFS('Scheme Information'!$B$5:$B$20000,COMPILED!$A2,'Scheme Information'!$A$5:$A$20000,COMPILED!H$1)>0,"Yes","")
The VBA code I have written always errors at the .Range stage.
Sub COUNTIFS_Formula()
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
'Name sheets for reference
Set sourceSheet = Worksheets("Scheme Information") ' SOURCE
Set outputSheet = Worksheets("COMPILED") ' OUTPUT
'Determine last row of Scheme Information sheet
With sourceSheet
SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'Add in formula
With outputSheet
OutputLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
.Range("H2:H" & OutputLastRow).Formula = "=IF(COUNTIFS('" & sourceSheet.Name & "!$B$2:$B$" & SourceLastRow & "," _
& outputSheet.Name & "$A2," & sourceSheet.Name & "'!$B$2:$B$" & SourceLastRow & "," & outputSheet.Name & "!H$1)>0" & "," & ""YES"" & "," & "")"
End With
End Sub
It is much easier to solve a problem if you break it down into smaller parts.
.Range("H2:H" & OutputLastRow).Formula = "=IF(COUNTIFS('" & sourceSheet.Name & "!$B$2:$B$" & SourceLastRow & "," _
& outputSheet.Name & "$A2," & sourceSheet.Name & "'!$B$2:$B$" & SourceLastRow & "," & outputSheet.Name & "!H$1)>0" & "," & ""YES"" & "," & "")"
At the very least you should assign the formula to a string variable before you assign it to the Range.Formula. This makes it easy to print the result out to the Immediate Window for inspection.
Sub COUNTIFS_Formula()
Dim Source As Range
Dim SourceFormula As String
With wsSchemeInformation
Set Source = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Offset(0, 1)
SourceFormula = FormulaAddress(Source)
End With
Dim OutputFormula As String, OutputA2Formula As String, OutputH2Formula As String
Dim Output As Range
With wsCompiled
Set Output = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Offset(0, 1)
OutputFormula = FormulaAddress(Output)
OutputA2Formula = FormulaAddress(.Range("A2"))
OutputH2Formula = FormulaAddress(.Range("H2"))
End With
Dim FormulaRange As Range
Set FormulaRange = Output.EntireRow.Columns("H")
Dim FormulaParts As Variant
FormulaParts = Array("=IF(COUNTIFS(", SourceFormula, ",", OutputA2Formula, ",", SourceFormula, ",", OutputH2Formula, ")>0", ",", """YES""", ")")
Dim Formula As String
Formula = Join(FormulaParts, "")
FormulaRange.Formula = Formula
End Sub
Function FormulaAddress(Target As Range)
FormulaAddress = "'" & Target.Parent.Name & "'!" & Target.Address
End Function
Function wsCompiled() As Worksheet ' OUTPUT
Set wsCompiled = ThisWorkbook.Worksheets("COMPILED")
End Function
Function wsSchemeInformation() As Worksheet ' SOURCE
Set wsSchemeInformation = ThisWorkbook.Worksheets("Scheme Information")
End Function

Replace All Cells in Column G with a Formula

Am I missing something here? I'm getting a 1004 during debug
Sub perc()
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("G2:G" & lastRow).Formula = "=IF((AND(A2<>"",F2>0)),F2/C2, "")"
End Sub
You need to qualify your objects - What workbook/worksheet does the Range and Rows object exist on? The assumed object references may be incorrect
You need to double up on your blank quote strings inside the formula
Sub Perc()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("G2:G" & lr).Formula = "=IF((AND(A2<>"""", F2>0)), F2/C2, """")"
End Sub

Remove all the "Selections" from a recorded Macro

I recorded this then added the LR = LastRow to make it dynamic but I can not figure out how to remove all the selections that go on
Also these both do the samething but is one way of writting the array better then the other i.e faster, more stable...
Thanks
Selection.FormulaArray = "=ISNUMBER(MATCH(RC[-5]&RC[-6],R1C1:R" & LR & "C1 & R1C2:R" & LR & "C2,0))"
Selection.FormulaArray = "=ISNUMBER(MATCH(B1&A1,$A$1:$A$" & LR & " & $B$1:$B$" & LR & ",0))"
Recorded Macro
Sub Winding()
Dim ws As Worksheet
Dim Rng As Range
Dim LR As Long
Set ws = Sheets("Unpivot_RegistrationData")
LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Set Rng = ws.Range("G1").Resize(LR, 1)
Range("G1").Select
Selection.FormulaArray = "=ISNUMBER(MATCH(B1&A1,$A$1:$A$" & LR & " & $B$1:$B$" & LR & ",0))"
Selection.AutoFill Destination:=Rng, Type:=xlFillDefault
End Sub
Firstly, preference for A1 or R1C1 style should be driven by ease of constructing the formula string. There is no diffrence in performance or stability
To remove the Selection try this
Note that I have removed the AutoFill, and applied to formula to the whole range in one step.
Sub Winding()
Dim Rng As Range
Dim LR As Long
With Worksheets("Unpivot_RegistrationData")
LR = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rng = .Range("G1:G" & LR)
End With
Rng.Cells(1, 1).FormulaArray = _
"=ISNUMBER(MATCH(B1&A1,$A$1:$A$" & LR & " & $B$1:$B$" & LR & ",0))"
Rng.Cells(1, 1).AutoFill Destination:=Rng, Type:=xlFillDefault
End Sub

How to manage sumproduct with VBA?

I wrote the following code: I'm trying to use sumproduct function with vba but it doesn't work. I've tried with evaluate function but I got the same bad result.
Dim row As Long
Dim rows As Range
Dim us As Integer
Dim rng As Range
Dim rngl As Range
Dim rngo As Range
Dim rngp As Range
With Sheets("Report")
LastRow = .Range("C" & .rows.Count).End(xlUp).row
End With
Set rng = ThisWorkbook.Sheets("REPORT").Range("g3:g" & LastRow)
Set rngl = ThisWorkbook.Sheets("REPORT").Range("F3:f" & LastRow)
Set rngo = ThisWorkbook.Sheets("REPORT").Range("c3:c" & LastRow)
For us = 3 To 33
Range("e" & us).Value = Application.Evaluate("=SUMPRODUCT((sheets(luglio).Range(c & us))<rng)*(sheets(luglio).Range(c & us)=rngl)")
Next us
As Rory mentions in the comments, this isn't working because VBA is passing the entire string inside the quotations marks to Excel. You need to concatenate the strings to get the desired output as you would see in the Excel formula.
Try replacing the line:
Range("e" & us).Value = Application.Evaluate("=SUMPRODUCT((sheets(luglio).Range(c & us))<rng)*(sheets(luglio).Range(c & us)=rngl)")
With:
Range("e" & us).Value = "=SUMPRODUCT((luglio!C" & us & "<REPORT!G3:G" & LastRow & ")*(luglio!C" & us & "=REPORT!F3:F" & LastRow & "))"

Append cell to a different cell

I Have a Column C that has names in all its cells and another Column E that has the same company name in all its cells I need to append the names in Column C to the company name in column E
Thanks
Ex:
ColC ColE
Bob SampleCo
Sally SamplCo
I get
ColC ColE
Bob SampleCo Bob
Sally SamplCo Sally
I am trying but failing with
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Dim rRange As range
Set rRange = range("E2")
rRange.Select
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.range("F" & Ws.Rows.Count).End(xlUp).Row
Ws.range("E2:E" & LastRow).FormulaR1C1 = "=rRange &RC[-1]"
range("E2:E" & LastRow).Copy
range("E2:E" & LastRow).PasteSpecial xlPasteValues
End Sub
Code
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.Range("E" & Ws.Rows.Count).End(xlUp).Row
Ws.Range("F2:F" & LastRow).FormulaR1C1 = "= RC[-1] & "" "" & RC[-3]"
End Sub
If you want the output in Column E its not possible using FormulaR1C1.
Any formula which work for excel interface will work for FormulaR1C1.
With that i mean (considering the image) in cell F2 you can manullay enter a formula = E2 & " " & C2 which will give you desired output. But if you enter in cell E2the formula as =E2 & " " & C2 the cell E2 will loose its value and this may even lead to circular reference issue.
It can be achieved using below code.
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Dim rng As Range, cell As Range
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.Range("E" & Ws.Rows.Count).End(xlUp).Row
Set rng = Ws.Range("E2:E" & LastRow)
For Each cell In rng
cell = cell & " " & cell.Offset(0, -2)
Next
End Sub
Here's some code that should help you with what you want...I don't typically use ranges for loops because it's easier to use .Cells(row, col) for me, but anyways:
EDIT: Added Sub Opening/Closing Syntax and edited to use WS instead of ActiveSheet so it's closer to what you want
Sub CompanyName()
Dim WS as Worksheet
Dim vRow
Dim vRowCount As Integer
Set WS = Sheets("WP_SubjectList_Ready")
'Gets Row # of Last Row for Column E
vRowCount = Range("E" & Rows.Count).End(xlUp).row
'Assuming Both Columns have the same row count and you have a header row
For vRow = 2 To vRowCount
WS.Cells(vRow, 5).Value = WS.Cells(vRow, 5).Value & " " & WS.Cells(vRow, 3).Value
Next vRow
End Sub

Resources