Search for Values in PivotTable and Copy into Different Sheet - excel

I am creating a tool to track project labor costs across multiple sites at our company. I ran into an issue implementing this as not all projects are worked on each month. As such I have had to modify to the tool to account for all projects each month regardless of if they were worked on.
I need to search for 17 individual strings in a PivotTable and if the string is found copy all cells below that string into another tab which calculates the cost. This find and copy function is where I am stuck.
I created some code that copied the data that was specific to a location of the string, but it did not account for the fact the project title (string) will be in the same place in this table each month when this is run. The position of where this data will be copied however does not change.
Appreciate any guidance to get me started...

I am basing this off of the code that you posted in your comment. I found the desired range using:
First Row of the data below the header (assumed to be row 4)
Last Row of data (calculated by finding the largest row that has a cell with data)
Column of the project title match
Sub TRM0000()
Dim Ws As Worksheet
Dim firstRow As Long
Dim lastRow As Long
Dim column As Long
Dim Calc As Range
Set Ws = Sheets("PivotTable")
firstRow = 4
lastRow = Ws.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
column = Ws.Range("C3:Z3").Find(What:="TRM-0000", LookIn:=xlValues, LookAt:=xlWhole).column
Set Calc = Ws.Range(Ws.Cells(firstRow, column), Ws.Cells(lastRow, column))
Calc.Copy
Sheets("Cost Calc").Range("B5").PasteSpecial xlValues
End Sub
This should be a solution for this specific project title. However, you said you have 17! Instead of recreating this code for each, I would recommend storing the 17 project titles (could be in a tab of the workbook or enumerated in the VBA code), creating a for loop to run through that list, and making the project title and output range references dynamic in the VBA code.

Related

How to clear data in a sheet using vba

I am trying to clear a data in a worksheet in excel using vba. I want to clear the cells with data in them, not including Row 1. I am trying to get the variable of the last row and column with data but I keep getting an out of range error.
Dim lRow As Long
Dim lCol As Long
lRow = Sheets("Sheet1").Cells(Sheets("Sheet1".Rows.Count,1).End(xlUp).Row
lCol = Sheets("Sheet1").Cells(1, Sheets("Sheet1").Columns.Count).End(xlToLeft).Column
I want to use this logic to replace what I have hard coded:
Sheets("Sheet1").Range("A2:D1000").ClearContents
I am using multiple sheets so that's why I am specifying Sheet1. How can I do this?
Thanks.
You were missing a Parenthesis in the last row line
you do not need to find the last column unless you are limiting the clear contents to preserve data.
One more thing, you are finding the last row in column A only, so if there is data in another column lower that the last one in column A, you won't clear that data.
lRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count,1).End(xlUp).Row
Sheets("Sheet1").Rows("2:" & lRow).ClearContents
Dim ws As Worksheet
set ws = Sheets ("Sheet1")
ws.Range(ws.Cells(2,1),ws.Cells(ws.UsedRange.Rows.Count,1).EntireRow.Delete
should do the trick. UsedRange tracks the smallest rectangle in the worksheet containing all cells with data and starting from A1.

How can I get VBA to copy formulas into a calculated range on every worksheet that matches a pattern?

I'm trying to automate the following problem: I have an excel workbook with a large number of quotes (each quote tab is in the format of "Q-#####"). Each quote tab has a series of calculations. I updated cell "L6" on every tab. Starting on row 6, there are a number of SKUs - each quote tab has a different number of SKUs.
The below is trying to do the following:
Determine if the worksheet starts with "Q-"
Determine the row of the last SKU (None go past row 100 so I put that to hopefully save time) then I remove 5 because I want to count the number of rows past L6
I want to then set the range as L6 to the last row by using the integer I determined in step 2
Then I want to copy the formula in L6 and paste it into every cell in my range (it's a very long formula that uses relative references so I wanted paste formulas)
I fixed my previous error (thanks BigBen) and now the copy/paste function is only working on the first identified Q- tab. On the subsequent Q tabs, I can see it selecting the right ranges but the paste doesn't work.
Accountant here, so I'm trying my best but a complete novice!
For Each ws In Worksheets
If ws.Name Like "Q-*" Then
Dim nRows As Integer
nRows = ws.Range("L6:L100").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
nRows = nRows - 5
Range("L6").Copy
Dim cell As Range
Set cell = Range("L6")
cell.Resize(nRows, 1).Select
cell.PasteSpecial (xlPasteFormulas)
End If
Next ws
End Sub```

How can I create a formula using VBA to reference a dynamically offset range of cells?

This is a very strangely specific need, and the last thing I need to complete my suite of new macros.
Note: The '---' at the top of the sheet is there to represent several months of the same report going back in time
As you can see in the image linked above, I have two highlighted sections. I need to make column G the sum of E and F from the previous report's numbers. Because there is a new set of data added every day, I can't reference specific cells and it must be dynamic. The larger problem here is that my number of customers will change every so often. It will only go up and it will always be in the same order; even if a lose a customer they stay on the report in the same spot.
My only theories on how to get this done are:
Find the second to last instance of customer A and define a rng based on the offset cells to the right. My problem with this is that—to my understanding—even filling that formula all the way down will just give me the one value.
Adding =SUM((INDIRECT(ADDRESS(ROW()-5,COLUMN()-2))):(INDIRECT(ADDRESS(ROW()-5,COLUMN()-1)))) to the blank cells. My problem with this is that the -5 in the offset is able to change, and even defining it by the number of blank cells will cause a mistake the first time a new customer comes on.
Any insight would be very much appreciated. And please let me know if you have any clarifying questions; I'm happy to answer/edit the original post as needed.
It can probably be optimised further by actually pre-calculating the range, but the naive version would be:
=SUMIFS([Outstanding Mail],[Date],LOOKUP([#Date]-1,[Date]),[Customer],[#Customer])
+SUMIFS([Outstanding Faxes],[Date],LOOKUP([#Date]-1,[Date]),[Customer],[#Customer])
Which relies on the fact that your dates are sorted, and that LOOKUP returns the last value that is not greater than the supplied value, so the [#Date]-1 makes it look up the biggest date that is less than the provided date. Will not work on an unsorted range.
#Gserg got an answer ahead of me, and his solution is one good elegant line, although i think it goes on the assumption there will be items every day there (if I`m not wrong?), and your screenshot suggest they may not be consecutive days all the time.
If you are still looking at a VBA solution as well, I would do something like this:
Option Explicit
Sub addOffsetFormula()
'Declare and set your workbook
Dim wb As Workbook: Set wb = ActiveWorkbook
'Declare and set your spreadsheet
Dim shData As Worksheet: Set shData = wb.Worksheets("Data")
'Set your last row/column for a dynamic aproach
Dim lRow As Long: lRow = shData.Cells(1, 1).End(xlDown).Row
Dim lCol As Long: lCol = shData.Cells(1, shData.Columns.Count).End(xlToLeft).Column
'Declare some further variables to help
Dim R As Long, X As Long
Dim sumFormula As String
'Declare and set your array to hold your data - much faster to iterate through the array than spreadsheet itself
Dim tblData(): tblData = shData.Range(shData.Cells(1, 1), shData.Cells(lRow, lCol))
For R = LBound(tblData) + 1 To UBound(tblData) 'Iterate through your data
For X = LBound(tblData) + 1 To UBound(tblData) 'Iterate through the same data again
If tblData(R, 4) = tblData(X, 4) And X > R Then 'Check for match with the next client found (assuming clients are unique)
'Set your formula to a variable, helps with debugging
sumFormula = "=SUM(R[-" & X - R & "]C[-2]+R[-" & X - R & "]C[-1])"
'Assign the formula to the respective cell _
If the spreadsheet is massive, you might need to add some optimisation _
(ie: assign everything to an array first, then dump into the spreadsheet)
shData.Cells(X, 7).FormulaR1C1 = sumFormula
End If
Next X
Next R
End Sub
Note: It won't add anything to the first few lines or new clients, as there is nothing to match against previously, but i expect that should work the same with any formula too.

Find the last row with data and autoFit everything

I'm creating an extract in Excel with data from a datatable in my vb.net application. It extracts everything correctly. Now I'm trying to do a bit of design work to make it all pretty. It seems like I'm having an issue with probably something every easy but for some reason I keep getting the below error.
Public member 'XlDirection' on type 'ApplicationClass' not found.
My goal is to find the last row of data in Column A, and then take all cells starting A4 and do .columns.autofit on all columns starting A4 The reason why I'm doing that is because cells A1 - A3 have some long text values in them and I want them to be as they are.
Code:
Dim wSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim _excel As New Microsoft.Office.Interop.Excel.Application
wSheet = wBook.ActiveSheet()
Dim lRow As Long
With wSheet
lRow = .Range("A" & .Rows.Count).End(_excel.XlDirection.xlUp).Row
.Range("A4" & lRow).Columns.AutoFit()
End With
The original error was due to the fact that XlDirection is an enumeration in the Microsoft.Office.Interop.Excel namespace - it isn't a member of Excel.Application. The bit _excel.XlDirection.xlUp should be:
Microsoft.Office.Interop.Excel.XlDirection.xlUp
The second issue is that the Range you build here...
lRow = .Range("A" & .Rows.Count).End(_excel.XlDirection.xlUp).Row
.Range("A4" & lRow).Columns.AutoFit()
...just appends a row number to the end of "A4". So if the last row was 42, the range you would auto-fit would be "A442". It needs to be ("A4:A" & lRow).
But that still only auto-fits column A. If that's your intent, stop here. If you need to auto-fit all the columns (as indicated by the phrase "all columns starting A4" - my emphasis), read on.
First, you don't need to find the last row number - you're working with Columns when you're performing your auto-fit, so Rows.Count works as well as anything else. You really need to find the right-most column, but I'd skip all of that and just offset the used range down by 3 rows:
With wSheet
.UsedRange.Offset(3).Columns.AutoFit
End With

Trouble Figuring out How to replace Cells in a Range with Specific Text - Excel VBScript

I must be having a brain fog at this point because I am certain this is easy to do, and in fact I have managed to create other functions that are a bit more complicated for this project.
Anyway, what I am trying to do. I have a sheet (inventory-data) and in column 1, it lists a company name, which is a same for all the rows. i.e. each of the 1900 or so rows have companyname in the first cell.
Now, while the data will always be the same at each application, the number of rows will change.
So, I need a function that will first determine what the last row of data is in the range, and then change all of the cells in column one of each record to name_company. The company names will always be the same so I can staticly assign them. Here is what I have that does not work.
I was able to get it to work another way, but it would replace text all the way down to the very last row of the worksheet, way beyond where the data stops.
Thanks!
Sub changeCompany() 'Changes company name as pulled from Agemni into proper ETA format
Dim myCell As Range
Dim RngToChange As Range 'The range of cells that need to be changed
Dim LastRow As Long 'Declare variable to help determine the last row on a variable length worksheet
Dim i As Integer
With Worksheets("inventory-data") 'set the range to change
Set RngToChange = .Columns(1)
End With
LastRow = Worksheets("inventory-data").UsedRange.Rows.Count 'Have Excel determine what the last row is.
For i = LastRow To 1 Step -1
RngToChange.Cells.Value = "name_company"
Next i
End Sub
I've always had more success with [SomeCellOrRange].CurrentRegion.Rows.Count e.g:
Range("A1").CurrentRegion.Rows.Count
UsedRange looks for any use of cells, not limited to a continuous tabular block. It also sometimes needs you to re-save the workbook before it will properly shrink after you have eliminated some rows.

Resources