I'm trying to put a formula into a range of cells without using autofill. I had it working with autofill before but want to change it and can't seem to get it to work. Can someone tell me what I'm doing wrong? Unable to set the FormulaArray property of the Range cHere is what I have:
With ActiveSheet.ListObjects(1)
Cells(1, .ListColumns.Count - 5).Value = "STUDENT POINTS"
Range(Cells(3, .ListColumns.Count - 5), Cells(.ListRows.Count + 1, .ListColumns.Count - 5)).FormulaArray = "=IF(SUM(" & Range("E3").Address(False, True) & ":" & Cells(3, intTotalItems + 4).Address(False, True) & ")>0,SUM(" & Range("E3").Address(False, True) & ":" & Cells(3, intTotalItems + 4).Address(False, True) & "),"""")"
'rngAssignment.Offset(2, intTotalItems + 1).AutoFill Destination:=Range(rngAssignment.Offset(2, intTotalItems + 1), rngAssignment.Offset(2, intTotalItems + 1).End(xlDown))
End With
Note: The fourth line is commented out. I used that line for the previous way.
Thanks!
I've had a go at this. You have an undefined symbol
intTotalItems
If I try to substitute something in for that and also for variable
lColCountMinusFive
then the code works and the formula array functions. Admittedly, I did pull your code apart whilst debugging and defined some interim variables...
Sub T()
Dim intTotalItems
Dim lColCountMinusFive As Long
With ActiveSheet.ListObjects(1)
lColCountMinusFive = 1 'Meaden .ListColumns.Count - 5
Cells(1, lColCountMinusFive).Value = "STUDENT POINTS"
Dim rngToFill As Excel.Range
Set rngToFill = Range(Cells(3, lColCountMinusFive), Cells(.ListRows.Count + 1, lColCountMinusFive))
Dim sSum As String
sSum = Range("E3").Address(False, True) & ":" & Cells(3, intTotalItems + 4).Address(False, True)
rngToFill.FormulaArray = _
"=IF(SUM(" & sSum & ")>0,SUM(" & sSum & "),"""")"
End With
End Sub
What was the error message (if one)?
Related
I have some data:
For each column, I want to calculate the average of the most current year. In the example below, I want to calculate it for 2020, so rows 164, 165 and 166. The result should appear in row 163.
However, I want not just the result, I want the formula so the user can see what is being calculated, but I can't. Maybe relevant: I'm using German Excel. I tried using .FormulaLocal and MITTELWERT(German for AVERAGE) but I think I'm making a different kind of mistake. With both .Formula and .FormulaLocal I'm getting a run time error 13 (type) in the line with the .Formula.
Sub FormulaLeased(ByVal fRow As Long, ByVal lCol As Long, ws As Worksheet)
Dim i As Long
Dim iCol As Long
'manually setting values for this example:
fRow = 164
lCol = 7
Set ws = ActiveSheet
With ws
Select Case Mid(.Cells(fRow, "A").Value, 4, 2) 'Determining the most recent quarter
Case "12"
i = 3
Case "09"
i = 2
Case "06"
i = 1
Case "03"
i = 0
End Select
For iCol = 2 To lCol
'---works, but only shows the result, not the forumla:
'.Cells(fRow - 1, iCol).Value = Application.WorksheetFunction.Average(.Range(.Cells(fRow, iCol), .Cells(fRow + i, iCol)))
'---results in type error:
.Cells(fRow - 1, iCol).Formula = "= Application.WorksheetFunction.Average(" & .Range(.Cells(fRow, iCol).Address(False, False) & ":" & .Cells(fRow + i, iCol).Address(False, False)) & ")"
'---trying to use .FormulaLocal -> Type error
'.Cells(fRow - 1, iCol).FormulaLocal = "= MITTELWERT(" & .Range(.Cells(fRow, iCol).Address(False, False) & ":" & .Cells(fRow + i, iCol).Address(False, False)) & ")"
Next iCol
End With
End Sub
Application.WorksheetFunction does not work with .Formula or .FormulaLocal. The .Formula needs the English formula as you would write it in the cell, and .FormulaLocal needs the localized formula (German) as you would write it in the cell.
So this approach was the one to go:
.Cells(fRow - 1, iCol).FormulaLocal = "= MITTELWERT(" & .Range(.Cells(fRow, iCol).Address(False, False) & ":" & .Cells(fRow + i, iCol).Address(False, False)) & ")"
but needs to be changed to
.Cells(fRow - 1, iCol).FormulaLocal = "=MITTELWERT(" & .Cells(fRow, iCol).Address(False, False) & ":" & .Cells(fRow + i, iCol).Address(False, False) & ")"
there is no Range needed just the addresses of the 2 cells.
Note that this code will only work if you run it in a German Excel because MITTELWERT will not be translated to other localizations. If you plan that your code should run on a French Excel too, then you would need to use the English formula and .Formula. This will translate to any localization and therefore work in all Excel versions. I highly recommend to use .Formula and translate them yourself into English (https://excel-translator.de might help):
.Cells(fRow - 1, iCol).Formula = "=AVERAGE(" & .Cells(fRow, iCol).Address(False, False) & ":" & .Cells(fRow + i, iCol).Address(False, False) & ")"
Beforehand, be aware that I just began using VBA, and I have few coding experience prior to it.
I have two sheets:
public
contacts
There is one parameter on column A that is definitely on "contacts" sheet, but may be or not be on column A on "public" sheet.
What I'm doing is:
Checking if the parameter contacts.A2 is on public.A2.
If it is, I need to copy columns, on the exact order:
public: A, C, G.
contacts: E, F.
I've found the following code online, and I'm running some adaptations to it, but I'm stuck.
Sub match()
Dim I, total, frow As Integer
Dim found As Range
total = Sheets("public").Range("A" & Rows.Count).End(xlUp).Row
'MsgBox (total) '(verifica se a contagem está ok)
For I = 2 To total
pesquisa = Worksheets("public").Range("A" & I).Value
Set found = Sheets("contacts").Columns("A:A").Find(what:=pesquisa) 'finds a match
If found Is Nothing Then
Worksheets("result").Range("W" & I).Value = "NO MATCH"
Else
frow = Sheets("contacts").Columns("A:A").Find(what:=pesquisa).Row
Worksheets("result").Range("A" & I).Value = Worksheets("public").Range("A" & frow).Value
Worksheets("result").Range("B" & I).Value = Worksheets("public").Range("C" & frow).Value
Worksheets("result").Range("C" & I).Value = Worksheets("public").Range("G" & frow).Value
Worksheets("result").Range("D" & I).Value = Worksheets("contacts").Range("F" & frow).Value
Worksheets("result").Range("E" & I).Value = Worksheets("contacts").Range("G" & frow).Value
End If
Next I
End Sub
What I expect:
to the code do ignore the line 1, as those are headers;
to eliminate de IF above, since I don't need the "NO MATCH"
to the resulting list to be ordered on ascending order, based on the A column.
Can you help me?
edited to include samples of the data and expected results:
I believe I can simplify my needs with the images above. I want to check a client on the public sheet, grab the manager contacts (emails) from the contacts sheet, and create a list that contains branch, manager, and both e-mails on the results sheet.
Creating those images, I realized I have forgotten to account for the second parameter (manager), as there can be multiple managers on a branch. So this is another parameter to account for.
`Public sheet (image)
Contacts sheet(image)
Result sheet(image)
spreadsheet
`
As per my comments, and your updated question with sample, I do believe that your current results do not match that what you say is required; which is looking for both parameters "Branch" and "Manager". Neither does your expected result look like the columns you wanted to extract according to your question. However, going by your sample data and expected output I tried the following:
Sub BuildList()
'Define your variables
Dim x As Long, y As Long
Dim arr1 As Variant, arr2 As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
'Fill 1st array variable from sheet Contacts
With Sheet1 'Change accordingly
x = .Cells(.Rows.Count, 1).End(xlUp).Row
arr1 = .Range("A2:D" & x).Value
End With
'Fill dictionary with first array
For x = LBound(arr1) To UBound(arr1)
dict.Add arr1(x, 1) & "|" & arr1(x, 2), arr1(x, 3) & "|" & arr1(x, 4)
Next x
'Fill 2nd array variable from sheet Public
With Sheet2 'Change accordingly
x = .Cells(.Rows.Count, 1).End(xlUp).Row
arr2 = .Range("A2:B" & x).Value
End With
'Compare array against dictionary and fill sheet Results
With Sheet3 'Change accordingly
y = 2
For x = LBound(arr2) To UBound(arr2)
If dict.Exists(arr2(x, 1) & "|" & arr2(x, 2)) Then
.Cells(y, 1).Value = arr2(x, 1)
.Cells(y, 2).Value = arr2(x, 2)
.Cells(y, 3).Value = Split(dict(arr2(x, 1) & "|" & arr2(x, 2)), "|")(0)
.Cells(y, 4).Value = Split(dict(arr2(x, 1) & "|" & arr2(x, 2)), "|")(1)
y = y + 1
End If
Next x
End With
End Sub
This solution makes use of arrays and dictionary which should be fast. It has given me the following result:
As David suggested, it would be better to have an input and output sample. Maybe you can try this:
Option Explicit
Public Sub match()
Dim wsPub As Worksheet
Dim wsCon As Worksheet
Dim wsRes As Worksheet
Dim pubRow As Long
Dim conRow As Long
Dim resRow As Long
Dim i As Long
Dim rng As Range
Dim cel As Range
Dim found As Long
Dim order(1 To 5) As Integer
Set wsPub = ThisWorkbook.Worksheets("public")
Set wsCon = ThisWorkbook.Worksheets("contacts")
Set wsRes = ThisWorkbook.Worksheets("result")
pubRow = wsPub.Cells(wsPub.Rows.Count, 1).End(xlUp).Row
conRow = wsCon.Cells(wsPub.Rows.Count, 1).End(xlUp).Row
resRow = wsRes.Cells(wsRes.Rows.Count, 1).End(xlUp).Row
Set rng = wsPub.Range("A2:A" & pubRow)
order(1) = 1
order(2) = 3
order(3) = 7
order(4) = 6
order(5) = 7
For Each cel In rng
If Not IsError(Application.match(cel.Value, wsCon.Range("A2:A" & conRow), 0)) Then
found = Application.match(cel.Value, wsCon.Range("A2:A" & conRow), 0) + 1
resRow = wsRes.Cells(wsRes.Rows.Count, 1).End(xlUp).Row
For i = 1 To 5
If i < 4 Then
wsRes.Cells(resRow, i).Offset(1, 0).Value _
= cel.Offset(0, order(i) - 1).Value
Else
wsRes.Cells(resRow, i).Offset(1, 0).Value _
= wsCon.Cells(found, order(i)).Value
End If
Next
End If
Next
wsRes.Range("A1").AutoFilter
wsRes.AutoFilter.Sort.SortFields.Clear
wsRes.AutoFilter.Sort.SortFields.Add2 Key:= _
Range("A1:A" & resRow), SortOn:=xlSortOnValues, order:=xlAscending, DataOption:= _
xlSortNormal
wsRes.AutoFilter.Sort.Apply
End Sub
I need to create a VBA script in excel that chanages an order number from having "CD" at the front to "CD" at the end so from "CD00001" to "00001CD"
Any help would be awesome. all of the order numbers are in Column B and start at row 5. please help.
What i have so far:
Private Sub OrderNumber_Click()
Dim Val As String
Dim EndC As Integer
EndC = Worksheets("Raw Data Upload").Range("A1048576").End(xlUp).Row
For i = 5 To EndC
Val = Right("B" & i, Len("B" & i) - 2) & Left("B" & i, 2)
Range("B" & i).Value = Val
Next
End Sub
This replaces the order numbers with B5, B6 and so on but if i put this function into Excel itself it works fine.
Like this? DO you want it in column B?
Option Explicit
Private Sub OrderNumber_Click()
Dim i As Long
Dim val As String
Dim EndC As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Raw Data Upload")
EndC = ws.Range("A1048576").End(xlUp).Row
For i = 5 To EndC
val = ws.Cells(i, "A")
Range("B" & i).Value = Mid$(val, 3, Len(val) - 2) & Left$(val, 2)
Next i
End Sub
dim beginStr, endStr, originalStr, outputStr as string
dim rng as range
'put the below into a loop, assigning a rng to the desired cell each time
originalStr = rng.value ' Change to chosen range
beginStr = left(originalStr,2)
endStr = right(originalStr, len(originalStr) - 2)
outputStr = endStr + beginStr
Range("B" & i).Value = outputStr
I haven't got a copy of Excel to test this on but it should work.
Simply use:
Right(Range("B" & i), Len(Range("B" & i)) - 2) & Left(Range("B" & i), 2)
An alternative is to set up the cell as a Range():
Sub t()
Dim cel As Range
Dim endC As Long
endC = Worksheets("Raw Data Upload").Range("A1048576").End(xlUp).Row
For i = 5 To endC
Set cel = Range("B" & i)
myVal = Right(cel, Len(cel) - 2) & Left(cel, 2)
Range("B" & i).Value = myVal
Next
End Sub
Currently, when you do Right("B" & i, Len("B" & i) - 2) & Left("B" & i, 2), for row 5, this becomes Right("B5", Len("B5") - 2) & Left("B5", 2) then this evaluates to simply:
Right("B5",0) & Left("B5",2), which is
[nothing] & B5, finally becoming
B5
Note the lack of using B5as a range. Instead it's being treated as a string.
(Also, I'm assuming this is to be run on the ActiveSheet. If not, please add the worksheet before the range, i.e. Worksheets("Raw Data Upload").Range("B" & i)...)
Try this
Private Sub OrderNumber_Click()
Dim cell As Range
With Worksheets("Raw Data Upload")
For Each cell in .Range("B5", .Cells(.Rows.Count, 2).End(xlUp))
cell.Value = Right(cell.Value, Len(cell.Value) - 2) & Left(cell.Value, 2)
Next
End With
End Sub
This is probably something quite obvious, but I have done quite a bit of googling to no avail.
First of all I am more than happy if you have a more succinct way of doing this, I am always keen to learn - this is the best way I could think of to achieve the task.
Basically, once the columns are found I will be transferring data from another sheet that will go at the end of Range(xlDown) and offset by 1 etc.
But at the moment, if i run this as For 1 to 6 it works fine, if I run for 1 to 7 it gives the error but everything is defined in the same way. strSoS is defined, but rngSoS always shows as 'Nothing' even though the other cells work fine?
Columns 1 to 7 have the 7 titles (as stated) in the list of String declarations, the reason it is done this way is that the sheet data will be coming from may have extra columns that wont be required.
Hope you can help solve my issue!
Sub ColumnSearch()
Dim strDoN, strOffice, strARN, strPIN, strAN, strAT, strSoS As String
Dim rngDoN, rngOffice, rngARN, rngPIN, rngAN, rngAT, rngSoS As Range
Dim myRange As Range
Dim NumCols, i As Integer
strDoN = "Date of Notification"
strOffice = "Office Centre"
strARN = "Appeal Reference Number"
strPIN = "PIN"
strAN = "Appellant Name"
strAT = "Appeal Type"
strSoS = "SoS Decision Date"
For i = 1 To 7
If Cells(1, i).Value = strDoN Then
rngDoN = Cells(1, i).Address(False, False)
ElseIf Cells(1, i).Value = strOffice Then
rngOffice = Cells(1, i).Address(False, False)
ElseIf Cells(1, i).Value = strARN Then
rngARN = Cells(1, i).Address(False, False)
ElseIf Cells(1, i).Value = strPIN Then
rngPIN = Cells(1, i).Address(False, False)
ElseIf Cells(1, i).Value = strAN Then
rngAN = Cells(1, i).Address(False, False)
ElseIf Cells(1, i).Value = strAT Then
rngAT = Cells(1, i).Address(False, False)
ElseIf Cells(1, i).Value = strSoS Then
rngSoS = Cells(1, i).Address(False, False)
End If
Next i
MsgBox rngDoN & rngOffice & rngARN & rngPIN & rngAN & rngAT & rngSoS
End Sub
You are trying to stuff a string address (text) into an unassigned Range object.
Dim strDoN, strOffice As String, strARN As String, strPIN As String
Dim strAN As String, strAT As String, strSoS As String
Dim rngDoN As Range, rngOffice As Range, rngARN As Range
Dim rngPIN As Range, rngAN As Range, rngAT As Range, rngSoS As Range
For i = 1 To 7
Select Case Cells(1, i).Value
Case strDoN
Set rngDoN = Cells(1, i) '<~~ set the range object to this cell
Case strOffice
Set rngOffice = Cells(1, i)
Case strARN
Set rngARN = Cells(1, i)
Case strPIN
Set rngPIN = Cells(1, i)
Case strAN
Set rngAN = Cells(1, i)
Case strAT
Set rngAT = Cells(1, i)
Case strSoS
Set rngSoS = Cells(1, i)
Case Else
'no match - do nothing
End Select
Next i
MsgBox rngDoN.Address(0, 0) & Chr(9) & rngOffice.Address(0, 0) & Chr(9) & _
rngARN.Address(0, 0) & Chr(9) & rngPIN.Address(0, 0) & Chr(9) & _
rngAN.Address(0, 0) & Chr(9) & rngAT.Address(0, 0) & Chr(9) & _
rngSoS.Address(0, 0)
Your narrative is a little short on what you actually want to accomplish. I've set the range objects to the matching cells and returned their addresses to the message box.
The rngSoS was failing because it is the only one actually declared as a range-type variable.
I have SUMIF running really really slow. My data has 14,800 Rows and 39 Columns.
I do the following:
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
EDITED TO ADD more potentially relevant code that may be interacting with the SUMIF command
It may be relevant to the speed issue so I'll mention it. I get the user to open a file from wherever they may have stored the report. The file then stays open. Maybe that is a problem. I don't know if it should be some other way.. like I close it but keep the address in mind or something??
FilterType = "Text Files (*.txt),*.txt," & "Comma Separated Files (*.csv),*.csv," & "ASCII Files (*.asc),*.asc," & "All Files (*.*),*.*"
FilterIndex = 4
Title = "File to be Selected"
File_path = Application.GetOpenFilename(FileFilter:=FilterType, FilterIndex:=FilterIndex, Title:=Title)
If File_path = "" Then
MsgBox "No file was selected."
Exit Sub
End If
Set wbSource = Workbooks.Open(File_path)
Original_Name = ActiveWorkbook.Name
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If
Set wb1 = ActiveWorkbook
Set ws1 = wb1.Worksheets("Sheet1")
With ws1
FinalColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
FinalRow = .Range("B" & .Rows.Count).End(xlUp).Row
For j = 1 To FinalColumn
If .Cells(1, j).Value = "Effec.Date" Then
Effective_Date_Column = j
ElseIf .Cells(1, j).Value = "FolderId" Then
FolderId_column = j
ElseIf .Cells(1, j).Value = "FolderNotional" Then
FolderNotional_column = j
End If
Next j
'range_Total_Folder_Fixed = .Cells(2, Total_Folder_Column).Address & ":" & .Cells(FinalRow, Total_Folder_Column).Address
range_FolderId_Fixed = .Cells(2, FolderId_column).Address & ":" & .Cells(FinalRow, FolderId_column).Address
range_FolderId_Cell = .Cells(2, FolderId_column).Address(RowAbsolute:=False, ColumnAbsolute:=False)
range_FolderNotional_Fixed = .Cells(2, FolderNotional_column).Address & ":" & .Cells(FinalRow, FolderNotional_column).Address
Everything runs in 8-10 seconds until we come to the lie below. Now the total time jumps to a 150 seconds.
.Range(range_Total_Folder_Fixed).Formula = "=SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_FolderNotional_Fixed & ")"
Am I doing something wrong? Is there a better (more efficient) way to write a general formula?
EDIT: Code generated Raw Formula
Some of the excel worksheet functions in my code:
.Range(range_Isnumber).Formula = "=(RIGHT(" & range_TradeId_cell & ",2)<> ""IB"")*1"
.Range(range_Is_IB).Formula = "=(RIGHT(" & range_TradeId_cell & ",2)= ""IB"")*1"
.Range(range_Exceptions).Formula = "=(SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_Isnumber_fixed & ")= COUNTIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "))*1+(SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_Is_IB_fixed & ")= COUNTIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "))*1 "
.Range("C13").FormulaR1C1 = "=SUM(IF(FREQUENCY(MATCH([SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,[SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,0),MATCH([SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,[SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,0))>0,1))"
So Stuff like
Range("I2")=SUMIF($H$2:$H$5,H2,$G$2:$G$5)
Where the data could be like
RowG RowH RowI
Alice 1 4
Alice 3 4
Bob 9 17
Bob 8 17
Dan 2 2
EDIT2 : Implementing Sam's solution, I am getting errors:
Set range_FolderId_Fixed = .Range(.Cells(2, FolderId_column), .Cells(FinalRow, FolderId_column))
Set range_FolderId_Cell = .Range(.Cells(2, FolderId_column),.Cells(FinalRow, FolderId_column))
Set range_FolderNotional_Fixed = .Range(.Cells(2, FolderNotional_column), .Cells(FinalRow, FolderNotional_column))
Set range_Total_Folder_Fixed = .Range(.Cells(2, Total_Folder_Column), .Cells(FinalRow, Total_Folder_Column))
.Range(range_Total_Folder_Fixed).Value = SumIf_func(range_FolderId_Fixed, range_FolderId_Cell, range_FolderNotional_Fixed)
I am getting a type application defined or object defined error in the line below.
.Range(range_Total_Folder_Fixed).Value = SumIf_func(range_FolderId_Fixed, range_FolderId_Cell, range_FolderNotional_Fixed)
I have no idea what to do next.
Ok this is what I came up with
Public Function SumIf_func(rng As Range, _
criteria As Range, _
sumRange As Range) As Variant()
Dim rngArr() As Variant
Dim sumArr() As Variant
Dim criteriaArr() As Variant
Dim returnArr() As Variant
Dim temp As Double
rngArr = rng.Value2
sumArr = sumRange.Value2
criteriaArr = criteria.Value2
If UBound(sumArr) <> UBound(rngArr) Then _
Err.Raise 12345, "SumIf_func", "Sum range and check range should be the same size"
If UBound(sumArr, 2) <> 1 Or UBound(rngArr, 2) <> 1 Then _
Err.Raise 12346, "SumIf_func", "Sum range and check range should be a single column"
ReDim returnArr(1 To UBound(criteriaArr), 1 To 1)
For c = LBound(criteriaArr) To UBound(criteriaArr)
returnArr(c, 1) = Application.WorksheetFunction.SumIf(rng, criteriaArr(c, 1), sumRange)
Next c
SumIf_func = returnArr
End Function
This function takes in three ranges:
The range to check
The range where the criteria are
The range where the values to sum are
The range to check and the sum range should both be the same length and only be 1 column across.
The array that is returned will be the same size as the criteria array..
Here is an example of usage:
Public Sub test_SumIf()
Dim ws As Worksheet
Set ws = Sheet1
Dim rng As Range, sumRng As Range, criteria As Range
Set rng = ws.Range("A1:A100")
Set sumRng = ws.Range("B1:B100")
Set criteria = ws.Range("C1:C10")
ws.Range("D1:D10").Value = SumIf_func(rng, criteria, sumRng)
End Sub