I have written the following code to edit the range of a two pivot tables. Up until the line of stars my code functions properly, however I get a "Run-time error '1004': Application-defined or object-defined" error on the .PivotCache.SourceData = rng.Address(True, True, xlR1C1, True) line. I have no idea what the cause of the error is as I copied the code from above and only changed the sheet name and pivot table name (they both definitely exist in my file). Any help?
Dim RowCount As Integer
Dim ColCount As Integer
Dim rng As Range
Dim CurrentPeriod As String
Dim PivotList As Variant
Dim Piv As String
Dim PivotSht As String
Dim PivotNme As String
RowCount = WorksheetFunction.CountA(Sheets("Data").Range("A:A"))
ColCount = WorksheetFunction.CountA(Sheets("Data").Range("1:1"))
Set rng = Sheets("Data").Range(Sheets("Data").Cells(1, 1), Sheets("Data").Cells(RowCount, ColCount))
CurrentPeriod = Sheets("Static").Range("CurrentPeriod")
With Sheets("Val Cat Current Returns (Adj)").PivotTables("CatCurrentPivot1")
.PivotCache.SourceData = rng.Address(True, True, xlR1C1, True)
.PivotFields("Period_id").CurrentPage = CurrentPeriod
.PivotCache.Refresh
End With
**********************************
With Sheets("Val Cat Trend Returns (Adj)").PivotTables("CatTrendPivot1")
.PivotCache.SourceData = rng.Address(True, True, xlR1C1, True)
.PivotCache.Refresh
End With
After hours of investigation I couldn't work out what was causing the error in my file. I ended up using an alternative to .PivotCache.SourceData = rng.Address(True, True, xlR1C1, True) which is Sheets(PivotSht).PivotTableWizard SourceType:=xlDatabase, SourceData:=rng. In order to use this approach you must have a cell within the chosen pivot table selected. To get around this you can locate the top left cell of the pivot table using Sheets(PivotSht).PivotTables(PivotNme).TableRange2.Cells(1).Address. My full code is below, it references the "Static" sheet, which is where all of my pivot table names and sheets are listed. (Also see the comment from Siddharth Rout for a better way to find the range of data).
Sub CurrentPeriodPivots()
Dim RowCount As Integer
Dim ColCount As Integer
Dim rng As Range
Dim CurrentPeriod As String
Dim PivotList As Variant
Dim Piv As String
Dim PivotSht As String
Dim PivotNme As String
Dim PivotLoc As String
RowCount = WorksheetFunction.CountA(Sheets("Data").Range("A:A"))
ColCount = WorksheetFunction.CountA(Sheets("Data").Range("1:1"))
Set rng = Sheets("Data").Range(Sheets("Data").Cells(1, 1), Sheets("Data").Cells(RowCount, ColCount))
CurrentPeriod = Sheets("Static").Range("CurrentPeriod")
For i = 8 To 9
PivotSht = Sheets("Static").Cells(i, 1).Value
PivotNme = Sheets("Static").Cells(i, 2).Value
PivotLoc = Sheets(PivotSht).PivotTables(PivotNme).TableRange2.Cells(1).Address
Sheets(PivotSht).Select
Range(PivotLoc).Select
Sheets(PivotSht).PivotTableWizard SourceType:=xlDatabase, SourceData:=rng
Sheets(PivotSht).PivotTables(PivotNme).PivotFields("Period_id").CurrentPage = CurrentPeriod
Sheets(PivotSht).PivotTables(PivotNme).PivotCache.Refresh
Next i
For i = 10 To 16
PivotSht = Sheets("Static").Cells(i, 1).Value
PivotNme = Sheets("Static").Cells(i, 2).Value
PivotLoc = Sheets(PivotSht).PivotTables(PivotNme).TableRange2.Cells(1).Address
Sheets(PivotSht).Select
Range(PivotLoc).Select
Sheets(PivotSht).PivotTableWizard SourceType:=xlDatabase, SourceData:=rng
Sheets(PivotSht).PivotTables(PivotNme).PivotCache.Refresh
Next i
End Sub
Related
I am attempting to populate columns D-J of table1, with the values in table2, columns B-H. The values should be based upon the value of column C in table1.
I have the code below, but I believe that is copying the tables as is and not doing a check of the value in column C.
Images:
Sub wps()
Dim rng As Range
Dim strTable As String
Dim strAddress As String
Dim i As Long
With Worksheets("Procedures")
For i = 1 To .ListObjects.Count
strTable = .ListObjects(i).Name
Set rng = .ListObjects(strTable).Range
strAddress = rng.Cells(2, 3).Address
rng.Copy Destination:=Worksheets("Base Data").Range(strAddress)
With Worksheets("Base Data")
.ListObjects(i).Name = "quals"
End With
Next i
End With
End Sub
It looks like a destination.value=source.value situation, using a single Match(). You could wrap this in a loop on your destWS.
Maybe something like (mock-up, untested):
For i = 2 to lastRowDest
dim sourceWS as worksheet
set sourceWS = sheets(1)
dim destWS as worksheet
set destWS = sheets(2)
destinationSearchTerm = destWS.Cells(i,"C").Value
dim sourceRow as long
sourceRow = Application.Match(destinationSearchTerm, sourceWS.Columns("A"), 0)
destWS.Range(destWS.Cells(i,"D"), destWS.Cells(i,"J") = sourceWS.Range(sourceWS.Cells(sourceRow,"B"),sourceWS.Cells(sourceRow,"H")
Next i
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.
Sorry That I posted my whole code for better visual. I created getcol function to give it the string( column name ) and it returns the range of that column
Public Function getColRange(colName As String) As String
'create variables that will be used in this function
Dim first As String
Dim last As String
Dim col As String
Dim first_row As Integer
Dim first_str As String
Dim last_col As String
Dim last_row As Integer
Dim last_str As String
'loop to check if colname is equal in range between columns A and X, easy to change below
For Each i In Range("A1:X1")
If i = colName Then
'catches column, first and last rows
col = Split(i.Address(1, 0), "$")(0)
last_row = Range("A2").End(xlDown).Row
first_row = 2
'make first and last addresses as strings
first_str = "" & col & first_row
last_str = "" & first_col & last_row
'function ouput in the next line is a combination of above two strings
getColRange = "" & first_str & ":" & col & last_str
End If
Next
End Function
Option Explicit
Sub proper_text()
Dim name_rng As Range
Dim name_cell As Range
Dim name_selection As String
Dim city_rng As Range
Dim city_cell As Range
Dim city_selection As String
Dim col_name As String
Dim trim_name_row As Long
Dim trim_name_rng As Range
Dim trim_name_cell As Range
Dim col_city As String
Dim trim_city_row As Long
Dim trim_city_rng As Range
Dim trim_city_cell As Range
With Credentialing_Work_History
' First Part
name_selection = getColRange("Company_Name")
Set name_rng = Range(name_selection)
For Each name_cell In name_rng
name_cell.Value = WorksheetFunction.Proper(name_cell.Value)
Next
city_selection = getColRange("Company_City")
Set city_rng = Range(city_selection)
For Each city_cell In city_rng
city_cell.Value = WorksheetFunction.Proper(city_cell.Value)
Next
'Second Part
col_name = getColRange("Company_Name")
' To 'Find the last used cell in Col A
trim_name_row = Range(col_name).End(xlDown).Row
'Declare the range used by having the coordinates of rows and column till the last cell used.
Set trim_name_rng = Range(Cells(2, 9), Cells(trim_name_row, 9))
' Loop through the range and remove any trailing space
For Each trim_name_cell In trim_name_rng
trim_name_cell = RTrim(trim_name_cell)
'Go to the next Cell
Next trim_name_cell
col_city = getColRange("Company_Name")
trim_city_row = Range(col_city).End(xlDown).Row
Set trim_city_rng = Range(Cells(2, 10), Cells(trim_city_row, 10))
For Each trim_city_cell In trim_city_rng
trim_city_cell = RTrim(trim_city_cell)
Next trim_city_cell
End With
End Sub
Referring to the Same Worksheet
Always use Option Explicit. If you would have used it, you would have noticed that the variables city_selection and city_cell, and i are not declared.
When having a 'ton' of variables, keep them close to the 'action' to make the code more readable (see in Quick Fix). Use shorter variable names, always preferably (but not necessarily) descriptive.
When using the With statement, you have to use the period (dot, .) in front of Worksheets, Range, Cells, Columns, Rows...etc., e.g.:
With Credentialing_Work_History
Set name_rng = .Range(name_selection)
End With
In this example, you have made sure that the range is in the worksheet Credentialing_Work_History.
You don't have to loop through the cells of the range, you can use Proper and Trim on a range (if you will allow Trim instead of RTrim).
You have to qualify your ranges i.e. make sure they refer to the correct worksheet. See this also in the corrections of the function (added ws parameter).
Note that the function would be more useful if it would return a range instead of a range address so you could use e.g. Set name_rng = getColRange(Credentialing_Work_History, "Company_Name"). That could be one of your next tasks.
The Code
Option Explicit
Sub proper_text()
' Name
Dim name_selection As String
Dim name_rng As Range
name_selection = getColRange(Credentialing_Work_History, "Company_Name")
If name_selection <> "" Then
Set name_rng = Credentialing_Work_History.Range(name_selection)
name_rng.Value = Application.Trim(Application.Proper(name_rng.Value))
End If
' City
Dim city_rng As Range
Dim city_selection As String
city_selection = getColRange(Credentialing_Work_History, "Company_City")
If name_selection <> "" Then
Set city_rng = Credentialing_Work_History.Range(city_selection)
city_rng.Value = Application.Trim(Application.Proper(city_rng.Value))
End If
End Sub
Function getColRange(ws As Worksheet, colName As String) As String
'create variables that will be used in this function
Dim first As String
Dim last As String
Dim col As String
Dim first_col As String
Dim first_row As Long
Dim first_str As String
Dim last_col As String
Dim last_row As Long
Dim last_str As String
Dim rg As Range
'loop to check if colname is equal in range between columns A and X, easy to change below
For Each rg In ws.Range("A1:X1")
If rg = colName Then
'catches column, first and last rows
col = Split(rg.Address(1, 0), "$")(0)
last_row = ws.Range("A2").End(xlDown).Row
first_row = 2
'make first and last addresses as strings
first_str = "" & col & first_row
last_str = "" & first_col & last_row
'function ouput in the next line is a combination of above two strings
getColRange = "" & first_str & ":" & col & last_str
End If
Next rg
End Function
Sub proper_text_QuickFix()
Dim ws As Worksheet: Set ws = Credentialing_Work_History
' Name
Dim name_selection As String
Dim name_rng As Range
Dim name_cell As Range
name_selection = getColRange(ws, "Company_Name")
Set name_rng = ws.Range(name_selection)
Debug.Print name_rng.Address
For Each name_cell In name_rng
name_cell.Value = WorksheetFunction.Proper(name_cell.Value)
Next
' City
Dim city_name_selection As String
Dim city_rng As Range
Dim city_name_cell As Range
city_name_selection = getColRange(ws, "Company_City")
Set city_rng = ws.Range(city_name_selection)
Debug.Print city_rng.Address
For Each city_name_cell In city_rng
city_name_cell.Value = WorksheetFunction.Proper(city_name_cell.Value)
Next
' Trim Name
Dim col_name As String
Dim trim_name_row As Integer
Dim trim_name_rng As Range
Dim trim_name_cell As Range
col_name = getColRange(ws, "Company_Name")
trim_name_row = ws.Range(col_name).End(xlDown).Row
Set trim_name_rng = ws.Range(ws.Cells(2, 9), ws.Cells(trim_name_row, 9))
Debug.Print name_rng.Address
For Each trim_name_cell In trim_name_rng
trim_name_cell = RTrim(trim_name_cell)
Next trim_name_cell
' Trim City
Dim col_city As String
Dim trim_city_row As Integer
Dim trim_city_rng As Range
Dim trim_city_cell As Range
col_city = getColRange(ws, "Company_City")
trim_city_row = ws.Range(col_city).End(xlDown).Row
Set trim_city_rng = ws.Range(ws.Cells(2, 10), ws.Cells(trim_city_row, 10))
Debug.Print trim_city_rng.Address
For Each trim_city_cell In trim_city_rng
trim_city_cell = RTrim(trim_city_cell)
Next trim_city_cell
End Sub
I'm very new to VBA and should probably spend some time on debugging and learning the formalities of how code should be written.
I am using a loop that uses the Hlookup function to populate a table from on one sheet from data on a master sheet. (This is in the Sub SetMatrix). Within the Sub that performs this task I use some other UDF's, one which copies and pastes the variables (names from a 3rd sheet which may change) I want to lookup from the master sheet.
In any case it runs perfectly fine when the I use a hardcoded number for the row in the lookup function. However, once I try to use a variable (jpmRow instead of a number like 50) for the row it will work the first time only. Then when I run it again I get RunTime error 91 - object variable or withblock variable not set. The debugger take me back to the DynamicRange UDF, Set StartCell line, which confuses me because that is not where I am setting the row variable. Meanwhile if I use a constant for the row it lets me rerun the sub with success every time.
Here is the code:
Option Explicit
Dim wsTemplate As Worksheet
Dim ws As Worksheet
Dim TxtCell As Range
Dim PortfolioCell As String
Dim StartCell As Range
Dim EndCell As Range
Dim RangeParameter As Range
Dim jpmRow As Integer
Dim myColumn As Integer
Dim myRow As Integer
Function DynamicRange(TxtToFind As String) As Range
Dim k As Integer
k = iCount
Set ws = Sheets("Template")
Set StartCell = ws.Cells.Find(TxtToFind).Offset(2, 0)
myColumn = StartCell.Column
myRow = StartCell.Row
Set EndCell = ws.Cells(myRow + k - 1, myColumn)
Set DynamicRange = ws.Range(StartCell.Address, EndCell.Address)
'Set DynamicRange = RangeParameter
End Function
Function iCount() As Integer
Set ws = Sheets("Template")
Set StartCell = ws.Cells.Find("Ticker").Offset(2, 0)
Set EndCell = ws.Cells.Find("Total").Offset(-1, 0)
iCount = ws.Range(StartCell.Address, EndCell.Address).Rows.Count
End Function
Sub SetMatrix()
Dim StartTable As Range
Dim iRows As Range
Dim iColumns As Range
Dim myArray(50, 50) As Integer
Dim wsJPM As Worksheet
Dim i As Integer
Dim j As Integer
Set StartTable = Sheets("Correlation Matrix").Range("A3")
Set iRows = Range(StartTable.Offset(1, 0).Address, StartTable.Offset(iCount, 0).Address)
Set iColumns = Range(StartTable.Offset(0, 1).Address, StartTable.Offset(0, iCount).Address)
Set wsJPM = Sheets("JPM")
Sheets("Correlation Matrix").Cells.ClearContents
Sheets("Correlation Matrix").Cells.ClearFormats
DynamicRange("Asset Class").Copy iRows
DynamicRange("Asset Class").Copy
iColumns.PasteSpecial Transpose:=True
For i = 1 To iCount
For j = 1 To iCount
jpmRow = wsJPM.Cells.Find(StartTable.Offset(i, 0), SearchOrder:=xlColumns, LookAt:=xlWhole).Row
StartTable.Offset(i, j).Value = Application.WorksheetFunction.HLookup(StartTable.Offset(0, j), Sheets("JPM").Range("B1:BZ100"), jpmRow, False)
Next j
Next i
End Sub
I have 2 TextBox controls where criteria 1 and criteria 2 are passed. The function opens an Excel file provided in the filepath (destination1) and in Sheet2 the vlookup must take col A, col B and return col C value to textbox3.
However the error I get is:
System.NullReferenceException was unhandled HResult=-2147467261 Message=Object reference not set to an instance of an object.
Is there a simple way to use vlookup for searching 2 criterias in VB.NET?
Public Sub lookValue()
Dim cit1 As String
Dim cit2 As String
Dim xlApp As Excel.Application
xlApp = New Excel.Application
Dim wb As Excel.Workbook = xlApp.Workbooks.Open(destination1)
Dim sht As Excel.Worksheet
Dim userange As Excel.Range
Dim lastrow As Long
Dim lastcolumn As Long
Dim startcell As Excel.Range
'Finding the dynamic table range in sheet lookup
sht = wb.Worksheets("Sheet2")
startcell = sht.Range("A1")
'Find Last Row and Column
lastrow = sht.Cells(sht.Rows.Count, startcell.Column).End(Excel.XlDirection.xlUp).Row
lastcolumn = sht.Cells(startcell.Row, sht.Columns.Count).End(Excel.XlDirection.xlToLeft).Column
'select range
userange = sht.Range(startcell, sht.Cells(lastrow, lastcolumn))
'Constraints from 2 textboxs given in userform
If TextBox1.Text <> "" And TextBox2.Text <> "" Then
cit1 = TextBox1.Text
cit2 = TextBox2.Text
'calling vlookup function by passing the lookup range from above, return value in col C if col A in excel sheet(lookup)
'has textbox 1.value & col B in excel sheet(lookup) has textbox2.value
TextBox3.Text = Two_Con_Vlookup(userange, 3, cit1, cit2)
'xlApp.WorksheetFunction.VLookup(raw, userange, 1, False))
End If
End Sub
Function Two_Con_Vlookup(Table_Range As Excel.Range, Return_Col As Long, Col1_Fnd As String, Col2_Fnd As String) As Object
Dim rCheck As Excel.Range, bFound As Boolean, lLoop As Long
Dim xlmath As Excel.WorksheetFunction
'On Error Resume Next
rCheck = Table_Range.Columns(1).Cells(1, 1)
With xlmath
For lLoop = 1 To .CountIf(Table_Range.Columns(1), Col1_Fnd)
rCheck = Table_Range.Columns(1).find(Col1_Fnd, rCheck, LookIn:=Excel.XlFindLookIn.xlFormulas, LookAt:=Excel.XlLookAt.xlWhole, SearchDirection:=Excel.XlSearchDirection.xlNext, SearcbOrder:=Excel.XlSearchOrder.xlByRows, MatchCase:=False)
If UCase(rCheck(1, 2)) = UCase(Col2_Fnd) Then
bFound = True
Exit For
End If
Next lLoop
End With
If bFound = True Then
Two_Con_Vlookup = rCheck(1, Return_Col)
Else
Two_Con_Vlookup = "Match Not Found"
End If
End Function
You could use LINQ to query on the table you need are using the vlookup in and a 2nd query on the vlookup table, then combine the join the two queries. Run a loop for each query result to output your excel file column.