Here's my dilemma, I need to parse a series of 606 weeks worth of Billboard 200 charts for the position of 36 different albums. Here's what I've got so far...
https://docs.google.com/file/d/0B_tgNfDq0kXAakR5eHZ3bzJQVkk/edit?usp=sharing
Billboard just redid their website, so now Excel's webquery returns a very pretty and clean table. I created two formulas in columns A and B of my worksheet, A has the list of relevant dates (specifically every Saturday from 8/18/2001 until this week), and B makes hyperlinks to the charts based on the dates. The rest of the chart is color-coded for the benefit of my advisors, who will also be reviewing the sheet.
I've also manually webqueried the first chart, dated 2001-08-18, into its own worksheet. This worksheet hasn't been touched - its exactly what the webquery returned.
As you can see, the table spans to column G, and each entry takes up 3 rows. My focus is on columns C and D. Column D's rows for each entry are (top-to-bottom) Title, Artist, and Imprint|Label. The first row in Column C for each entry contains that week's position from 1 to 200. The pattern that emerges is that every 3rd row starting with 4 (so 7, 10, 13...) contains a position and album title (col C & D, resp.), and every 3rd cell starting with 5 contains an artist.
I'm going to try to explain what I'm imagining in plain English, but be forewarned that this may fail miserably.
So the macro would take two cells as input (can they even take input?), album title and corresponding artist. This input should tell the macro both the string stored in each cell and the location - e.g, E1, C2 - of said cell. The macro should loop through each URL in column A from row 3 to 608, querying the URL into a new sheet. This new sheet should be made active, and then every 3rd row starting with 4 should be searched sequentially for the album title string. Upon finding a match, the cell one row beneath the matching query cell should be compared to the artist name string. Should both strings match the content of their corresponding query cells, the number (from 1 to 200) in column C and the same row as the matching album title cell should be copied to the cell in the 'bb200' sheet corresponding to the URL queried and the album title searched. The loop should now recur on the next URL in the sequence. In the event no match is found (the album didn't chart that week, or BB returned a wonky table), the corresponding cell should be left blank. The macro should exit once the list of URLs is exhausted.
My problem is twofold: first off, is my thought process regarding the macro fundamentally sound? And second-but-most-importantly, I haven't the faintest clue where to even start writing this in VBA. I have studied Java, C, and most recently C++ (OpenGL, specifically). I'm totally unfamiliar with the VBA syntax and API, and frankly, my time on this is far too short to sit down and formally learn the language. After this, I plan on doing so in short order, but this assignment is due Monday and I had no idea how massive an undertaking it was going to end up being.
FOR THE RECORD, the macro is not the assignment, but the data to be collected is integral to completing it. To those curious, the assignment is to produce a complete rough draft of my senior thesis by Monday. This data will be used to create several graphs that my advisors have instructed me to include with my writing. The paper itself is already written based on simply reading each album's sales performance off the site.
You'd be helping me go above-and-beyond, as most of the other graduating seniors are turning in some seriously half-baked graphical representation. The only other student that went this far invented an instrument and provided schematics and autoCAD drawings. However, on that I digress.
Thanks in advance for the help!!
I think this should get you about 90%. The only thing this won't do is the web query.
For that part, I propose that you use the macro recorder to do a web query, and then post that code in a revision and we'll add it in and tailor it to your needs. You've gotta do some work on this :)
Option Explicit
Sub TestMacro()
Dim inputVal As String
Dim artistCell As Range
Dim artistName As String
Dim albumCell As Range
Dim albumName As String
Dim ws As Worksheet: Set ws = Sheets("thesisData")
Dim r As Long 'this will be our row iterator variable
Dim hLink As String 'string for each hyperlink in the iteration
Dim wsNew As Worksheet 'this will be used when we create new worksheets
Dim foundRange As Range 'this is how we will locate the album
Dim weekRank As Long 'weekly rank from column C
On Error GoTo InvalidRange 'This error handling is for the input box, to trap invalid arguments.'
'Use an input box to capture the cell address'
inputVal = InputBox("Please enter the cell location containing the ARTIST name", "Input Range")
Set artistCell = Range(inputVal) 'set a Range variable for the artist'
artistName = artistCell.Value 'string variable for artist name'
inputVal = vbNullString 'clear out the inputVal'
'Use an input box again...'
inputVal = InputBox("Please enter the cell location containing the ALBUM name", "Input Range")
Set albumCell = Range(inputVal) 'set a Range variable for the song cell'
albumName = albumCell.Value 'string for song name'
On Error GoTo 0
For r = 3 To 608 'iterate over rows 3 to 608
hLink = ws.Cells(1, r).Value
'Add a new sheet after the last sheet in this file'
Set wsNew = Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))
wsNew.Name = Format(ws.Cells(r, 2).Value, "YYYY-MM-DD")
'''' add VBA for web query, here.'
''''
'''' try using the macro recorder and we can tweak it to your needs.'
''''
''''
''''
'Rather than looping over all the cells in web query...'
Do
'Use the FIND method to look for matching album title in column D.'
' this uses exact text match, non-case-sensitive.
Dim fnd
Set foundRange = wsNew.Columns(4).Find(What:=albumName, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=False)
If Not foundRange Is Nothing Then
'if we've found a match, then just offset by 1 row and check against artist name'
If foundRange.Offset(1, 0) = artistName Then
'likewise, just offset the foundRange cell by -1 columns to get the weekly rank'
weekRank = foundRange.Offset(0, -1)
'At this point I'm not sure what cell you want to put this value in, '
' but I think you want row designated by "r" and the column of the '
' album name, so we can do that like this:
ws.Cells(r, albumCell.Column).Value = weekRank
End If
End If
Loop While Not foundRange Is Nothing
Next
Exit Sub 'before error handling
InvalidRange: 'error handling
MsgBox inputVal & " is not a valid range", vbCritical, "Error!"
End Sub
Good luck!
Edit this also assumes that there is only going to be one match in each web query. In the event there is more than one, it would only return the last match. That seems like a safe assumption given the nature of the data, but if that's not the case, let me know and I can tweak it.
Related
Okay, so don't mind the title, I had trouble summarizing my current issue. But first here is what I am trying to do :
I have three sheets, first one is containing a list of Attributes, the second a list of Categories and the third a cross table associating Attributes and Categories.
The code i'm working on is quite straightforward : when selecting one or many attributes (or categories) using checkboxes and executing the macro, the code will look for ticked checkboxes, get the ID associated to the selected attributes (or categories), then delete the line in the attribute (or category) worksheet and also in the cross table.
The sheets looks like that :
*Attribute Sheet*
*Category Sheet*
*Cross Table*
And here is my code :
Sub Delete_Selection()
Dim Wb As Workbook: Set Wb = Workbooks("DataBase WIP.xlsm")
Dim Sws As Worksheet: Set Sws = ActiveSheet
Dim CrossWs As Worksheet: Set CrossWs = Sheet6
Dim Cb As CheckBox
Dim Checking As Range
Dim LastRow As Long: LastRow = Sws.Cells(Sws.Rows.Count, "B").End(xlUp).Row
Dim CRow As Long, IDColumn As Long, IDRow As Long
Dim CID As String
IDColumn = Sws.Cells.Find(What:="ID", LookAt:=xlWhole).Column 'Look for the ID column in the current sheet
MsgBox (IDColumn) 'Debug purpose
For Each Cb In Sws.Checkboxes
If (Cb.Value = 1) Then 'If checkbox is ticked, proceed
CRow = Range(Cb.LinkedCell).Row 'Get the row number of the checkbox
MsgBox (CRow) 'Debug purpose
CID = Cells(CRow, IDColumn).Value 'Get the ID value
Rows(CRow).Delete Shift:=xlUp 'Delete the row
Cb.Delete 'Delete the checkbox
If (ActiveSheet.CodeName = "Sheet2") Then 'If attributes are being deleted, proceed
MsgBox (CID) 'Debug Purpose
IDRow = CrossWs.Cells.Find(What:=CID, LookAt:=xlWhole).Row 'Find the corresponding row in the cross table
CrossWs.Rows(IDRow).Delete Shift:=xlUp 'Delete it
End If
If (ActiveSheet.CodeName = "Sheet5") Then 'If categories are being deleted, proceed
MsgBox (CID) 'Debug Purpose
IDColumn = CrossWs.Cells.Find(What:=CID, LookAt:=xlWhole).Column 'Find the corresponding column in the cross table
CrossWs.Columns(IDColumn).Delete Shift:=xlToLeft 'Delete it
End If
End If
Next
End Sub
The issue :
The code works perfectly fine when selecting and deleting multiple attributes
The code works when selecting and deleting one category
BUT : when selecting multiple categories and running the deletion code, it deletes them all in the category sheet but it only delete one corresponding column in the cross table.
Example : if I want to delete the beef and beans category, I select them using the checkboxes then press the button, in the category sheet they're all successfully deleted (yay !) but only the beef column will be deleted in the crosstable.
So to figure out why, I decided to print the relevant variables, what is happening in the previous example is the following :
IDColumn = 1 which is normal
CRow = 10 fine too
CID = DOC9 expected
Then
IDColumn = 1 Wasn't supposed to change
Crow = 10 The rows have been shifted up to fill the gap so totally normal
CID = "" And that's where my issue is.
Despite looking at the right cell, CID don't get the value contained in it and I don't understand why at all.
Important precision, the attribute sheet is perfectly normal while the category sheet contains a Table ! I think that's where the issue lies but I couldn't find anything useful on the Internet.
And I don't understand why the program would be able the read the value of a cell the first time and then doesn't. I may have missed something obvious so I apologize if its the case but any help would be greatly appreciated !
Edit 1 : It has nothing to do with the Categories being in a table, I wrote a similar code but I ran into the exact same issue even without looking at a Table. I still don't know what's happening.
I found a workaround by first reading all my ID's and storing them into an array and then looping through my array to modify my cross table. I will probably do the same for my current issue.
Okay, I found the problem.
Once again I wasted a lot of time because of a stupid mistake.
When I was deleting a category, I needed to find the column linked to that category in my cross table, and I stupidly used the same variable referring to the ID column of my Category sheet (i.e. "IDColumn"), changing its value and therefore when reading the next ID, my code was looking in the wrong cell.
Thanks to anyone who have tried to help me ! I will hopefully not make a fool of myself next time ahah.
At my job I have automated a very manual task and to the point they have wanted to expand it to the other department where they work a little differently. So the goal of this is I want to be able to filter column "A" and then filter another column based off of phrases that I already have in place as well. The data in column "A" I would have a source in another sheet, but it would have around potentially 200-400 possibilities to look for. After it filters column A I then want it go to column "AG" and then do another loop filtering based off of provided key phrases that the analyst would select based on a data validation. Once it filters those two criteria I then have the codes in place to generate the spreadsheets for the analyst. The code below is an example of the first block, I have 4 other codes that are pretty much the same they just generate different templates, I had to do multiple codes cause I didn't know how to do a loop based off of a source.
Sub Generate_Consolidated_Update_Reports()
Dim EDI As String
EDI = Environ("USERPROFILE") & "\desktop\foldername\foldername2\foldername3\filename " &
Format(Now(), "MM.DD.YY")
Workbooks("Master(where the filtering happens)").Activate
'The next line of code I am just doing the second filtering which is based off of a data validation
'I created, essentially the analyst would just select a key phrase and then that would
'prompt the code to generate the template, I haven't figured out how to do it based off of
'the source that's why I just have the specific name in the key range
'The first step to the code would need to be looking for anything in column "A", but like
'I said that could be anywhere from 200-400 possibilities. I have access to it, though and have
'it listed in "Sheet2" along with the phrases in column "AG" as well.
ActiveWorkbook.Worksheets("Master").Sort.SortFields.Add Key:=Range("AG:AG" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Selection
.autofilter Field:=33, Criteria1:="Send to EDI Team - Account Level"
.Offset(1, 0).Select
End With
'The next line of code will be seeing if it is empty, I realized that it would work once,
'but if there ever was data the next line of looking for empty would always
'just filter anyways and keep creating the template even though there was no data
'so I did this route where if it saw it was empty I called another code, would be awesome
'if I could figure that out too!
'This then goes on repeat down the line, it's 5 different codes, so it isn't clean. :/
'so I only did one so you wouldn't see a ton of fluff!
Dim Lr As Long
Lr = Range("A" & Rows.Count).End(xlUp).Row
If Lr > 1 Then
Workbooks.Add
ActiveWorkbook.SaveAs EDI & ".XLS"
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "EDI Account Update"
'Redacted code, just fluff on creating the template for the analyst
'Next line is just doing the code to show all the data again
'Then within that if statement to then call another sub that is essentially the same process
'If the code doesn't find it it goes to else where it then just calls the other sub
If ActiveSheet.AutoFilterMode Then ActiveSheet.ShowAllData
Range("A1").Select
Call Create_EDI_Update_GroupLevel
Else
ActiveSheet.ShowAllData
Range("A1").Select
Call Create_EDI_Update_GroupLevel
End If
End Sub
The reason I have to also call other subs is because each criteria they select will generate a completely different template based on company policies and such.
Really sorry if this isn't clear, I am still learning coding and just having a hard time trying to explain exactly what I needed. Thank you so much for your time.
I wanted to add a comment but not enough reputation yet.
One question I have is: Are you filtering on one phrase among 200-400 or can it be multiple?
I can't be sure, however an Advanced Filter might help you in this case. It is not possible for me to go into all the details. There is a very good tutorial on Youtube about this (where I learned myself): VBA Advanced Filter - The FASTEST way to Copy and Filter Data
You can also use "Worksheet_Change" event to fill in the filter. Couple it with:
If Not Application.Intersect(Target,rngRange) is Nothing Then
' Your code here
' Where rngRange is a Range object that you want the change event to catch
End If
Another note is, you can use (considering data starts at "A1") Range("A1").CurrentRegion if you don't have any completely empty rows within your data instead of .End(xlUp). Actually you can use CurrentRegion in any cell that is inside the data range. Check out the behaviour by pressing CTRL + * after selecting a cell.
Dim rngData as Range
Set rngData = ws.Range("A1").CurrentRegion
' ws can be a worksheet object you can set alike range above or worksheet codename
' or Worksheet("SheetName")
' Then rngData.Row will give the top row of rngData
' rngData.Column will give you you the leftmost column
' rngData.Rows.Count will give the number of rows
' rngData.Columns.Count will give the number of columns
' rngData.resize() and rngData.Offset() helps a lot too, can be used in same line
' i.e., rngData.offset(2,0).resize(1,1) : move the range 2 rows down, resize to 1 row,1 column
' Do whatever with rngData
' After you are done clean up, doesn't matter most of the time in VBA but this is better
' from what I have read/learned from others
Set rngData = Nothing
This may not be the exact answer you are looking for, but may get you started. The video is 20 minutes long, see if it can be used in your case.
Edit 1: To further clarify
rngData part is more a general approach. You haven't said anything about being able to use Advanced Filtering but here how I would do it.
Assume, we have 3 sheets. wsData, wsFilter, wsReport.
wsData would be the sheet where data is entered.
wsFilter would only hold the filter criteria.
wsReport would be the sheet that you will export.
wsData, as an example assume row 1 is the header row.
wsFilter would be only 2 columns (with headers corresponding to A and AG), corresponding to Column A and AG.
On wsReport, you only have to clear contents and enter the column headers from wsData that you would want to appear on the customized report.
You will need 3 ranges, 1 for each worksheet. i.e., rngData, rngFilter, rngReport
The code to creating the report is easy as:
rngData.AdvancedFilter xlFilterCopy, rngFilter, rngReport
(I won't get into how to decide on the ranges as the video does it better than I would be able to).
Then next step should be: How to enter the filter criteria?
I'm new to the world of VBA and can't quite wrap my head around this macro I want to create.
Essentially, I have a monthly data set that comes in, but the data is imperfect. I often need to clear excess data values of one cell, based on the value of another.
The complex part is that the data will be displaced week to week, and the only thing that is static are the column headers that are included.
Just as an example, columns A thru E have headers Company1, Company2, Company3, etc.
Columns Q thru U have headers Product1, Product2, Product3, etc.
The product columns will contain the company names as values (often more than one, delimited by commas), and if the name of a company doesn't appear for ANY of the product columns, the cell of the same row for that company's column should be cleared.
So if Q4:U4 doesn't contain "Product1" as as value, the value at A4 (product 1 column, row 4) should be cleared.
Any insight on how to go about this would be much appreciated!
edit
Screenshot of example data:
Example 2
Try this. Create a new module within the VBA editor and copy in the below code ...
Public Sub ProcessData()
Dim objCompanyRange As Range, objProductRange As Range, objCompanyCell As Range
Dim strCompany As String, objThisProductRange As Range, rngFrom As Range
Dim rngTo As Range, objFindResult As Range, lngLastRow As Long
On Error Resume Next
' Get the range for the company data.
Set objCompanyRange = Application.InputBox("Please select the COMPANY data range, including headers ...", "Company Data", , , , , , 8)
If Err.Description <> "" Then Exit Sub
' Get the range for the product data.
Set objProductRange = Application.InputBox("Please select the PRODUCT data range, including headers ...", "Product Data", , , , , , 8)
If Err.Description <> "" Then Exit Sub
On Error GoTo 0
For Each objCompanyCell In objCompanyRange
' We want the headers in the range but want to skip processing the first row.
If objCompanyCell.Row > objCompanyRange.Cells(1, 1).Row Then
' This is the only contentious line for me. If your headers are specified as you had in your
' example, i.e. "Group: Company1" then the below will work. If that was a mocked example that
' was not 100% accurate, the below line will need to change. It is currently splitting the header
' by a colon and only storing the right hand side as the company.
strCompany = Trim(Split(objCompanyRange.Cells(1, objCompanyCell.Column).Text, ":")(1))
' Only reset objThisProductRange if the row has changed, otherwise we use the same set of
' products we used last time.
If objCompanyCell.Row <> lngLastRow Then
' Determine the range for the product data given the current row being processed
With objProductRange.Worksheet
Set rngFrom = .Range(.Cells(objCompanyCell.Row, objProductRange.Cells(1, 1).Column).Address)
Set rngTo = rngFrom.Offset(0, objProductRange.Columns.Count - 1)
End With
Set objThisProductRange = Range(rngFrom.Address & ":" & rngTo.Address)
End If
' Find the company name within the current row of Product data.
Set objFindResult = objThisProductRange.Find(strCompany, MatchCase:=False)
' Clear the cell if nothing was found.
If objFindResult Is Nothing Then
objCompanyCell.ClearContents
End If
End If
lngLastRow = objCompanyCell.Row
Next
End Sub
... now watch the animated GIF below to see how you launch it and the resulting output.
If selecting the datasets each time gives you the sh!ts then feel free to hardcode it or use your own determination method. It's the easiest approach given I don't know how you may want to do that.
Here's hoping it's what you're after. Be sure to read the comments in the code in case you have any questions.
I am exporting data from excel to a word table (11 rows 7 columns). I have written a macro to do this for me but I have come across a critical problem. The data I am entering comes from 3 different workbooks and each workbook goes into a different column in the table. Although this data comes from 3 different workbooks, it is grouped together. The units are tested at 3 different temperatures, and the data from each temp. goes into the correlating column of the word table. Here is my current code
Sub CopyAndPaste()
Dim myfile, wdApp As New Word.Application, wDoc As Word.Document
'select truck report file
ChDrive "E:\"
ChDir "E:\WG\TVAL\"
myfile = Application.GetOpenFilename(, , "Browse for Document")
Dim i As Integer
'searches for row with "avg" then selects column E(avg of temperature mean) of that row.
i = Application.Match("Avg", Sheet1.Range("A1:A20"), 0)
'makes the file appear
wdApp.Visible = True
Set wDoc = wdApp.Documents.Open(myfile)
With wDoc
Dim oRow As Row
For Each oRow In wDoc.Tables(8).Rows
If Len(oRow.Range) = 16 Then
With oRow
.Cells(1).Range.Text = "Performance Review"
.Cells(2).Range.Text = Range("e" & i)
.Cells(3).Range.Text = ""
.Cells(4).Range.Text = ""
.Cells(5).Range.Text = ""
End With
Exit For
End If
Next
End With
wDoc.Save
End Sub
Opens file path and then allows user to select the desired file
Finds the value I want to copy/paste or type into the word table
In word, searches table for first blank row, then types “performance review” into column 1 and types the value I want into the corresponding column of the table. (theres a column for each temperature)
This works great for the first value I add, but when I go to add the next two values it types into a new row when I want it to be in the same row as the first value entered. I know I need to change
If Len(oRow.Range)=16 Then
But I do not know what value to change it to so that it enters data into the row that already has Cells(1) with “Performance Review” and Cells(2) with the value range, and for the 3rd temp Cells(3) would also have a value.
The value for cells(2) will be something like 22.56. Cells(3) would be like 5.21
For each temperature I was planning on running a different macro, but I would like them to be similar to:
Dim oRow As Row
For Each oRow In wDoc.Tables(8).Rows
If Len(oRow.Range) = 16 Then
With oRow
.Cells(1).Range.Text = "Performance Review"
.Cells(2).Range.Text = Range("e" & i)
.Cells(3).Range.Text = ""
.Cells(4).Range.Text = ""
.Cells(5).Range.Text = ""
End With
So I want the first macro to take fill cells(1) and Cells(2), this I have already accomplished. The second macro I need only cells(3) to have data entered into it. And for the 3rd macro I need cells(4) to have the value entered into it.
Essentially all I need to solve is how to determine the value of the rows once the previous values have been entered.
Hopefully this makes sense, I have been doing vba for about a month so I am still fresh to it. If anyone needs additional information or screenshots of examples just let me know!
If someone sees what I am trying to do here and has a better way to solve my problem please share!
I was thinking maybe for the 2nd and 3rd macros I could search for the first blank cell in the table but I have not been able to find that!
P.S. With the 3rd macro, would like to include a line of code that will change the background color of the row to white
I have a spreadsheet that I will update monthly that tracks the percentage of applications approved.
I want to be able to hover over a cell and see, in a comment, data relevent to the contents of that cell. For example:
This is a snip of my Trend tab.
There is 2016Data tab where 123 is the count of applications received in the month of January 2016 and 102 is the count of applications that were approved. The 2016Data tab is static and does not change as it is historic reference to compare this year against last.
There is a 2017Data tab that has the same information but this information will be refreshed monthly.
NOTE: All application records on the data tabs are notated in column A:A with a 1 so I can sum the columns where other attributes exist to help me analyze data. As well each application is notated with a 1 or 0 in column B:B so I can sum that column to know the number of applications approved. Here is a sample of information on those data tabs:
I manually created the snip above to show what I'm trying to re-create in VBA and each time I refresh 2017Data I need all the counts to be updated in all of the comments automatically.
Also worth noting - I am a VBA toddler, and my experience with it is very limited.
Below is how you can create a comment to a cell.
Dim mySheet, myCell
Set mySheet = ThisWorkbook.Sheets("Sheet1")
Set myCell = mySheet.Cells(1, 1)
On Error Resume Next 'In case there is an existing comment to the cell already, you will get an error
myCell.AddComment
myCell.Comment.Visible = False
myCell.Comment.Text Text:="myComment text"
You will have to write to own logic to read the content from your source sheet and add as a comment on your destination.
'Read from a cell
Dim strCellVal
strCellVal = myCell.Value
'Write to a cell
myCell.Value = "My Cell Content"
--EDIT--
Try below to loop each cells,
Dim UsedRange, CurrentCell
' Assuming your data starts from cell A1
UsedRange = "$A$1:" + mySheet.Cells.SpecialCells(xlCellTypeLastCell).Address
For Each CurrentCell In mySheet.Range(UsedRange).Cells
MsgBox CurrentCell
Next