I am trying to create a UDF using the SUMPRODUCT function which will reference data in an external closed workbook and return a value based on a couple of different criteria.
The reason I am tyring to do this is because some of the formula in the file while using the SUMPRODUCT feature could end up quite long.
So far I have come up with the following and appear to be just getting a #value error returning.
Public Function ReceiptTotal(Criteria1 As Variant, Criteria2 As Variant, Criteria3 As Variant) As Variant
Dim wbk As Workbook
Dim wks As Worksheet
Dim Criteria1Column As Range
Dim Criteria2Column As Range
Dim Criteria3Column As Range
Dim ResultColumn As Range
Dim LastRow As Long
Set wbk = Workbooks("J:\Users\Sarah\New Cash Sheet Ideas\[Receipt Log Test.xlsm]")
Set wks = wbk.Worksheets("1819")
With wbk
With wks
LastRow = wbk.wks.Range("A" & Rows.Count).End(xlUp).Row
Set Criteria1Column = wbk.wks.Range("E5:E" & LastRow) 'Criteria1Column = Bank Account
Set Criteria2Column = wbk.wks.Range("F5:F" & LastRow) 'Criteria2Column = Receipt Type
Set Criteria3Column = wbk.wks.Range("J5:J" & LastRow) 'Criteria3Column = Date
Set ResultColumn = wbk.wks.Range("H5:H" & LastRow) 'ResultColumn = Receipt Value
ReceiptTotal = [SUMPRODUCT((ResultColumn) * (Criteria1Column = Criteria1) * (CriteriaColumn2 = Criteria2) * (CriteriaColumn3 = Criteria3)]
End With
End With
End Function
I would really appreciate if someone can advise where I am going wrong.
Related
I have this vba code that appends/distributes records from a Data mastersheet to individual named sheets. This is done based on column E's value. It works fine but ends in an error whenever it encounters a value on column E that's not one of the sheets in the file. Can you please help me so as to allow it to just skip those records and proceed with the processing? Thanks!
Sub CopyDataToSheets()
Dim copyfromws As Worksheet
Dim copytows As Worksheet
Dim cfrng As Range
Dim ctrng As Range
Dim cflr As Long
Dim ctlr As Long
Dim i As Long
Dim currval As String
Set copyfromws = Sheets("Data")
cflr = copyfromws.Cells(Rows.Count, "B").End(xlUp).Row
' Copy Row of Data to Specific Worksheet based on value in Column E
' Existing Formulas in Columns F through H or J are automatically extended to the new row of data
For i = 2 To cflr
currval = copyfromws.Cells(i, 1).Value
Set copytows = Sheets(currval)
ctlr = copytows.Cells(Rows.Count, "B").End(xlUp).Row + 1
Set cfrng = copyfromws.Range("A" & i & ":N" & i)
Set ctrng = copytows.Range("A" & ctlr & ":N" & ctlr)
ctrng.Value = cfrng.Value
Next
End Sub
I would make a small helper function that can test if the worksheet exists. That way you can control the logic of your loop.
Function SheetExists(sheetName As String, Optional wb As Workbook) As Boolean
If wb Is Nothing Then Set wb = ThisWorkbook
Dim ws As Worksheet
On Error Resume Next
Set ws = wb.Sheets(sheetName)
SheetExists = Err = 0
End Function
All, I am working part of my code where I want to update filtered noncontiguous cells with index / match. Core of my code is working in proper manner in another case but here seems wrong and do not know what is the reason behind. Working turn endless and could cause that no last row find in section here: Set rngI = usedR.Resize(usedR.Rows.Count - 1).Offset(5).Columns("I:I").SpecialCells(xlCellTypeVisible). Checked with debug.print the result which shows me the end as wrong...$I$174:$I$1046999...proper has to be $I$174:$I$197...what could be the reason behind?
Another question using lastrow calculation..on this way this doesnt work, Dim lastrow As Long, lastrow = rngD(Rows.Count, 1).End(xlUp).row I have to correct like this to count...lastrow = rngD(rngD.Rows.Count, 1).End(xlUp).row. What's the reason behind that once working on first way, once only if I double type range. This code is in Personal folder if it counts anyway
Sub Macro2()
Dim wbD As Workbook: Set wbD = Workbooks("dashboard-advanced.xls")
Dim wsD As Worksheet: Set wsD = wbD.Sheets("Sheet1")
Dim rngD As Range: Set rngD = wsD.Range("A:C")
Dim wbCallLCL As Workbook: Set wbCallLCL = Workbooks("CALL_REPORT.xlsx")
Dim wsCallLCL As Worksheet: Set wsCallLCL = wbCallLCL.Sheets("LCL")
Dim rngCallLCL As Range: Set rngCallLCL = wsCallLCL.Range("A:V")
rngCallLCL.autofilter Field:=10, Criteria1:=Blanks
Dim lastrow As Long
lastrow = rngD(rngD.Rows.Count, 1).End(xlUp).row
Dim usedR As Range, rngI As Range, A As Range, C As Range
Set usedR = wsCallLCL.UsedRange
Set rngI = usedR.Resize(usedR.Rows.Count - 5).Offset(1).Columns("I:I").SpecialCells(xlCellTypeVisible)
For Each A In rngI.Areas
For Each C In A.Cells
res = Application.Match(C.Value, wsD.Range("A2:" & "A" & lastrow), 0)
If IsError(res) Then
C.Offset(, 1).Value = ""
Else
C.Offset(, 1).Value = Application.WorksheetFunction.Index(wsD.Range("B2:" & "B" & lastrow), res, 0)
End If
Next C
Next A
End Sub
I don't know where I'm missing. I'm trying to provide the formula from a specific row to the last row in an excel table. I'm getting "unable to get the match property of the worksheetfunction class: 1004" error
when I use worksheetfunction.match and "Run time Error - 13 - Type Mismatch" when I use Application.match
Below is the code I have tried:
Sub PTO_Calculations()
Dim UBSht As Worksheet
Dim x As Long
'Variables for PTO Data
Dim PTOSht As Worksheet
Dim PTORows As Long, PTOCols As Long
Dim PTOOldRows As Long
Dim PTOWholeRange As Range
Dim PTOFirstColumnRange As Range
Dim PTOFirstRowRange As Range
'Variables for Table in UB Sht
Dim UBTable As ListObject
Dim UBTableRows As Long, UBTableCols As Long
Dim UBTableOldRows As Long
Set UBSht = ThisWorkbook.Sheets("UB - US & IND")
Set PTOSht = ThisWorkbook.Sheets("PTO Data")
Set UBTable = UBSht.ListObjects("UB_US_IND")
UBTableRows = UBTable.ListRows.Count + 1
UBTableCols = UBTable.ListColumns.Count
UBTableOldRows = UBTableRows - WorksheetFunction.CountIf(UBSht.Range("A:A"), Format(DateAdd("m", -1, Date), "mmmm - yyyy")) 'UBSht.Range("XFD1").Value
PTORows = PTOSht.Range("A" & Rows.Count).End(xlUp).Row
PTOCols = PTOSht.Cells(1, Columns.Count).End(xlToLeft).Column
Set PTOWholeRange = PTOSht.Range(Cells(1, 1).Address, Cells(PTORows, PTOCols).Address)
Set PTOFirstColumnRange = PTOSht.Range("A:A")
Set PTOFirstRowRange = PTOSht.Range(Cells(1, 1).Address, Cells(1, PTOCols).Address)
'I'M FACING ERROR IN THE BELOW STEP
Range(UBTable.Range(UBTableOldRows + 1, 6), UBTable.Range(UBTableRows, 6)).Value = _
Application.WorksheetFunction.Index(PTOWholeRange, Application.Match([#[Team Member Name]], PTOFirstColumnRange, 0), Application.Match([#Month], PTOFirstRowRange, 0))
end sub
Thank you for your help in advance.
Below is the code which I came up to get all the source formating whenever I require a vlookup type operation in excel. I am also getting any formulas by this way. If there is a way to elimate the formula and get only the value and formating then it will be of great help.
Option Explicit
Sub finding()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet2")
Dim i As Integer
Dim FoundRange As Range
Dim sFoundRange As String
Dim range_to_copy As Range
Dim range_to_paste As Range
Dim ToFindString As String
For i = 2 To 9
ToFindString = ws.Cells(i, 1)
On Error Resume Next:
sFoundRange = ws1.Range("E1:E12").Find(ToFindString).Address
Debug.Print sFoundRange
Set range_to_copy = ws1.Range(Replace(sFoundRange, "E", "F"))
Set range_to_paste = ws.Range("B" & i)
range_to_copy.Copy
range_to_paste.PasteSpecial xlPasteAllUsingSourceTheme
Application.CutCopyMode = False
Next i
End Sub
In order to check if a cell contains a formula, you might use the worksheet function =FormulaText(). I did a test with the Formula property of a range, but this did not work. (Maybe you might check if the first character is a = sign)
My code is working when I just use a single workbook and communicate between sheets but gives me subscript out of range errors and object not defined errors when I attempt to reference a cell range in a sheet contained in a different work book. Right now, the error is occurring at "Set pidat = Worksheets("pidat")
Dim pival As Double
'Dim eom As Worksheet 'declaring pidat worksheet as variable
'Set eom = Worksheets("EOM") 'declaring eom worksheet as variable
'Set Inv_Level = Worksheets("Inv_Levels")
Dim pidat As Worksheet 'declaring eom worksheet as variable
Set pidat = Worksheets("pidat")
Dim steve As Workbook
Set steve = Application.Workbooks("EOM Report VBA")
Dim EOMAs As Workbook
Set EOMAs = Application.Workbooks("EOMA")
Dim Inv_Level As Worksheet
'These changes allow for a dynamic range to be referenced outside of the active sheet/workbook
Dim location As String
Dim rownum As Long
Dim loopy As Long
Dim fRng As Range
Dim J As Long
Dim rn As Date
Dim last As Date
Dim rnm As Integer
Dim lastm As Integer
Dim tyear As Long
Dim K As Long
With pidat
J = .Range("J2").Value
rn = Now
last = .Range("B1").Value
rnm = month(rn)
lastm = month(last)
tyear = year(rn)
If lastm < rnm Then
.Range("B1") = (rnm & "/" & "01" & "/" & tyear & " 07:30")
J = J + 100
.Range("J2") = J
End If
End With
K = J + 100
'names of workbook/sheet referenced
With steve
rownum = .Range("E" & Rows.Count).End(xlUp).Row 'counts the number of rows in the location tag column
For loopy = 3 To rownum 'Data values start after row 3, loops through each row in the column
If .Range("E" & loopy) <> "" Then
location = .Range("E" & loopy)
'newloc = location
With Inv_Level
Set fRng = .Cells.Range("A" & J, "ZZ" & K).Find(What:=location, LookIn:=xlFormulas, LookAt:=xlPart) 'eom can be any sheet you need to perform the .Find again
End With
If Not fRng Is Nothing Then
fRng.Offset(0, -1) = pidat.Range("D" & loopy)
Else: End If
'if the search item is not found, do nothing, go to next loop
End If
Next loopy
End With
End Sub
You need to qualify the specific workbook you want to work with.
The line Set pidat = Worksheets("pidat") will fail if the active workbook at the time this line is executed has no worksheet named pidat.
Here is an example of how to qualify a workbook
Dim theWorkbook as Workbook
Set theWorkbook = Application.Workbooks("myWorkbook")
Dim pidat as Worksheet
Set pidat = theWorkbook.Worksheets("pidat")
You could go one step further and verify that a sheet named pidat (or whatever) exists in the qualified workbook, but I'll leave you to discover how to do that :)