Large Data set Macro query & alternative to Vlookup request - vba

This query is two fold. Any assistance would be much appreciated and unfortunately there is a lot of detail behind this so apologies for the great deal of text.
I am working on updating a 12 month trending report that pulls data from one sheet using a series of complex vlookups based on several criteria (Project, unique project id, Order, yr-month etc). Yes it would likely be easier to use pivot tables, but unfortunately because of the way this document is used the people with access to it want it to remain as is, from a format and function perspective but want the document sped up (takes roughly 5 minutes to calculate when ever something is changed.)
The data set is 36 columns by 50000 rows with 7 columns containing identifiers used to pull in specific data on the trending sheet
As it current sits on a monthly basis new data (approximately 6000 rows) of additional data is added.
I've added two macros to the document in an attempt to reduce user error
I am currently using the following code to take the order number remove the duplicates and then apply an index/match to pull in the relevant Project and then use countif to apply a unique key to the end of the project (using concatenate)
Sub ProjTrending1()
Dim s1 As Worksheet, s2 As Worksheet
'Defines S1 as a Worksheet
Set s1 = Sheets("All Data")
'Defines S2 as WorkSheet
Set s2 = Sheets("Workings")
'Defines LastR1
Dim LastR1 As Long, DataRange1 As Range
'Finds last row cell working sheet
LastR1 = s2.Range("A1").CurrentRegion.Rows.Count
'Takes Data from Order Column of defined data Sheet and copy & pastes it to Working Sheet Column B
s1.Range("J1:J" & LastR2).Copy s2.Range("A1")
'Removes Duplicates from Column B Working sheet
s2.Range("A2:A" & LastR1).RemoveDuplicates Columns:=2, Header:=xlNo
'Copies the formula from B2 and applies it to all cells in column B where column A has values
s2.Range("B2").Copy s2.Range("B2:B" & LastR1)
'Copies the formula from C2 and applies it to all cells in column C where column A has values
s2.Range("C2").Copy s2.Range("C2:C" & LastR1)
End Sub
The formula is column B is as follows
=INDEX('All Data'!E:E,MATCH(Workings!A2,'All Data'!J:J,0))
The formula in column C is as follows
=B2&COUNTIFS($B$2:B2,B2)
The data set in worksheet All Data is approx 50k rows long and will continue to grow. The issue I'm not running into is that this macro is starting to take a great deal of time to run because the information in column C is used as a unique identifier on the trending report.
Is this because I have a vast number of Vlookups on the trending tab (approx 20k) pulling data based on this or is there an issue with the macro I have created to create a unique identifier?
I've been looking at alternative ways in which I could draw the data through to the trending tab (dictionaries etc) with no luck so far. It would be much appreciated if someone could offer an alternative to 20k vlookups.

Related

Excel VBA: Concatenate lists with differing number of rows

So, this should be an interesting one...
I have 2 separate reports that provide customer satisfaction information on tickets (if I was able to get the data in 1 list, then this issue would not exist...). Each list provides information including, most importantly, the ticket number. One list provides a customer comment, while the other list provides a customer satisfaction score on a 1-5 scale.
A simple concatenate matching ticket numbers would be fairly easy, however, the database designer failed to make the customer comment field mandatory, so approximately 50% of the tickets have no comment.
I have both sheets with the past 60 days of information, however the one with scores is nearly double the size in row number. What I need to do is combine the lists using first the score sheet, since it will include every ticket, then adding in the comment sheet, matching the comments with their respective tickets.
I am not even sure how to start this code, and I am not looking for finished code, only suggestions on direction.
Pseudo code would be something like:
Clear useless columns in each sheet
Sort each sheet by ticket creation date (or ticket number)
Copy survey comment sheet into survey score sheet, leaving a blank column or two in the middle.
Assuming that column A and column G include the ticket numbers, sort so that the values match up, and the rows with no survey comment value are blank for column G
Any direction is much appreciated!
Something along the following will do what you want:
Sub foo()
LastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row 'find how many rows on Sheet1
LastRow2 = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row 'Find how many rows on Sheet2
For i = 2 To LastRow 'loop from row 2 to last row
Sheet1.Cells(i, 3).FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet2!R1:R1048576,2,FALSE)"
'enter the Vlookup formula on column number 3, change this number to suit your needs, also change the 2 before FALSE to the column number you wish to bring into Sheet1
Next i
End Sub

How to autofill down based on another column in VBA?

I am trying to autofill a range based on the number of values in column A. Here is my code:
Dim Pricing As Worksheet
Dim lrp As Long
lrp = Pricing.Range("A3" & Pricing.Rows.Count).End(xlUp).Row
Pricing.Range("B3:AR3").AutoFill Destination:=Pricing.Range("B3:AR" & lrp)
The pricing worksheet data starts in column 3 and starts in column B and goes all the way to AR. When I run this code, no error appears. No data gets autofilled down.
I need the range to auto fill down based on the adjacent column (Column A). Any idea how to achieve that?

How to move parts of a dynamic pivot table to a separate table?

I have pivot table pulling data from a query from a proprietary database system we use at work. I'm trying to figure out a way to move certain parts of the pivot table to a different sheet where it wouldn't exist as a pivot table there. My problem I'm running into is that the table changes the number of columns and rows depending upon the types and amounts of things that we shipped that shift, so I can't have it simply have my new table equal the cell values in the pivot table.
This is an example of the pivot data having fewer columns and rows based on what occurred that shift at work.
The reason why I would like this in a regular table as opposed to a pivot table is because there's other calculations I'd like to put into the table that extend beyond a pivot table's capabilities (ex. have the user id be displayed as their name, and have a weighted system based off of what the driver moves, but I suppose that's irrelevant.)
I've been poking around the internet, and it seems that the majority of answers to this issue deal with static tables. Any help would be appreciated!
Let's assume you want the cell to have the value from "BEER Total" for "M307577". Then this would be the formula you put in the cell:
=VLOOKUP("M307577",A5:Z100,MATCH("BEER Total",A5:Z5,0),FALSE)
"A5:Z100" would be the whole pivot table and "A5:Z5" would be the first row containing variables.
As you mentioned you are not familiar with VBA, I would suggest this approach:
Use the first column and first row of the second sheet as a reference. Refer to all the variables from the pivot table there (refer to the cell containing IDs and Variables, and pull the formula to the last row for IDs and last column for variables (or a reasonable range as last column and row would not be sufficient)). This will leave you with zeros, empty cells from the pivot table sheet, but will have all the names that you need.
Then refer to those cells and use the aforementioned formula (instead of names, use the cells that you just created).
Whenever the pivot table updates, those cells will be updated as well and you will see the values for the corresponding ID and Variable.
I think you want the GETPIVOTDATA function. Determine what your logic will look like and click on the appropriate combination of cells. Excel will automatically setup the GETPIVOTDATA function appropriately for you.
http://www.contextures.com/xlPivot06.html
Also, if the last used columns and last used rows are changing, you will probably need a Macro to help you with your task.
Sub LastRowInOneColumn()
'Find the last used row in a Column: column A in this example
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
MsgBox LastRow
End Sub
Sub LastColumnInOneRow()
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
MsgBox LastCol
End Sub
You can use a combination of functions to help you get the last used cell in a specific range.
https://exceljet.net/formula/address-of-last-cell-in-range
From there, I think you can figure out your next steps.
Post back with more information if you still have trouble with this, or start a new post if your question is answered.

Copying values across a dynamic column and row range

I have the following code that:
copies the column headings (in row 1) from column C across to the second last column
pastes these column headings in row 1 in the column 2 across from the last column with data
pastes the column headings alongside each row of data through to the bottom row
Sub GLDR()
'use End(xlUp) to determine Last Row with Data, in column A of the GLDRYYPP tab
Dim lastRowDR As Long
lastRowDR = Sheets("GLDRYYPP").Range("A" & Rows.Count).End(xlUp).Row
'copy the cost type categories and paste alongside the cost centres
CTNameCol = "S2:AF" & lastRowDR
Sheets("GLDRYYPP").Range("C1", Range("C1").End(xlToRight).Offset(0, -1)).Copy
Sheets("GLDRYYPP").Paste Destination:=Sheets("GLDRYYPP").Range("C1").End(xlToRight).Offset(0, 2)
Sheets("GLDRYYPP").Range(Range("C1").End(xlToRight).Offset(0, 2), Range("C1").End(xlToRight).Offset(0, 2).End(xlToRight)).Copy
Sheets("GLDRYYPP").Paste Destination:=Sheets("GLDRYYPP").Range(CTNameCol)
End Sub
The first two steps have been set to be dynamic for any additional columns added but I am having trouble writing some code that will paste the data through to the bottom row. As you can see the range "S2:AF(last row)" has been written to make use of the result from the lastRowDR dimension.
Is there a way to write the code which will make the copy dynamic across the columns and rows?
Yes there is a way to write the code which will make the copy dynamic across the columns and rows. What you need to do is to identify a distinct quality about the cost centres so that you locate it using something like ActiveSheet.Cells.Find(Txt).
Then you'll be able to determine what CTNameCol should be. There is some helpful info here: Range.Find Method.
If you add add a picture of your spreadsheet I will update this answer with more precise information.

Copying Row Info from one sheet to another based on match

I have an excel book that has two sheets: 1) Import 2) Pricing Rules.
Pricing Rules Sheet
The A column is what I need to match on. Example values include STA_PNP4, STA_PST.. and others. There are potentially around 50 different rows in the sheet, and it will continue to grow over time. Then for each row, there are pricing values in columns B to CF.
Import Sheet
This sheet has the same number of columns, but only Column A is filled out. Example values include STA_PNP4_001_00, STA_PNP4_007_00, STA_PST_010_00.. and many more.
What I need to do:
If the text in Import Sheet Column A before the second "_" matches the column identifer in Pricing Rules Sheet Column A, copy the rest of B to CF of Pricing Rules sheet for that row into the Import sheet for the row it matched on.
Any idea on where to begin with this one?
Why don't you do it using formulas only?
Assuming :
1.) Data in Import Sheet is
(col A)
STA_PNP4_007_00
STA_PNP4_001_00
STA_PNP4_001_00
.
.
2.) Data in Pricing Rules Sheet
(Col A) (col B) (ColC) (Col D) .......
STA_PNP4 1 2 3 .....
STA_PST 4 5 6 .....
STA_ASA2 7 8 9 .....
Then write this formula in B1 cell of Import Sheet
=IFERROR(VLOOKUP(LEFT(A1,FIND("",A1,FIND("",A1)+1)-1),PricingRules!$A$1:$CF$100,2,0),"")
Drag it down in column B
and For Column C , D just change index num from 2 to (3 for C) , (4 for D) and like that.
Because it will continue to grow over time you may be best using VBA. However, even with code I would start by applying the ‘groups’ via formula, so as not to have a spreadsheet overburdened with formulae and hence potentially slow and easy to corrupt. Something like part of #xtremeExcel’s solution which I repeat because the underscores have been treated as formatting commands in that answer:
=LEFT(A1,FIND("_",A1,1+FIND("_",A1))-1)
I’d envisage this (copied down) as an additional column in your Import Sheet - to serve as a key field to link to your Pricing Rules Sheet. Say on the extreme left so available for use by VLOOKUP across the entire sheet.
With that as a key field then either:
Write the code to populate Pricing Rules Sheet as frequently as run/desired. Either populating ‘from scratch’ each time (perhaps best for low volumes) or incrementally (likely advisable for high volumes).
Use VLOOKUP (as suggested). However with at least 84 columns and, presumably, many more than 50 rows that is a lot of formulae, though may be viable as a temporary ‘once off’ solution (ie after population Copy/Paste Special/Values).
A compromise. As 2. But preserve a row or a cell with the appropriate formulae/a and copy that to populate the other columns for your additions to your ColumnA and/or ColumnA:B.
Thanks for the input guys.
I got it implemented via a method like this:
{=VLOOKUP(LEFT($A4,7),PricingRules!A3:CF112,{2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84},FALSE)}
That is my ugly function, applied across a whole row, to look up and copy from my pricing rules every column when it finds a match.
Below is the function that I have created for above scenario. Its working as per the requirement that you have mentioned.
Sub CopyData()
Dim wb As Workbook
Dim importws As Worksheet
Dim PricingRulesws As Worksheet
Dim Pricingrowcount As Integer
Dim importRowCount As Integer
Dim FindValue As String
Dim textvalue As String
Dim columncount As Integer
Dim stringarray() As String
'Enter full address of your file ex: "C:\newfolder\datafile.xlsx"
Set wb = Workbooks.Open("C:\newfolder\datafile.xlsx")
'Enter the name of your "import" sheet
Set importws = Sheets("Import")
'Enter the name of your "Pricing" sheet
Set PricingRulesws = Sheets("PricingRules")
For Pricingrowcount = 1 To PricingRulesws.UsedRange.Rows.Count
FindValue = PricingRulesws.Cells(Pricingrowcount, 1)
For importRowCount = 1 To importws.UsedRange.Rows.Count
textvalue = importws.Cells(importRowCount, 1)
stringarray = Split(textvalue, "_")
textvalue = stringarray(0) & "_" & stringarray(1)
If FindValue = textvalue Then
For columncount = 2 To PricingRulesws.UsedRange.Columns.Count
importws.Cells(importRowCount, columncount) = PricingRulesws.Cells(Pricingrowcount, columncount)
Next columncount
End If
Next importRowCount
Next Pricingrowcount
End Sub