I want to retrieve a number from the stock website TipRanks, specifically how much upside the stock has according to analyst. It is a simple number to grab and place in a cell range. First off, I am not familiar with coding in VBA at all. I found some video that explains how to retrieve data from a website and used that code. I edited the code where it was needed. Here is my sample code:
Sub StockRetrieve()
Dim bot As New WebDriver
bot.Start "chrome"
For i = 3 To 16
link = Sheets(1).Range("A" & i).Value
bot.ExecuteScript "window.open(arguments[0])", link
bot.SwitchToNextWindow
upside = bot.FindElementByXPath("//*[#id='tr-stock-page-
content']/div[1]/div[4]/div[2]/div[2]/div[3]/div/div/div[1]/div[1]/div").Text
Sheets(1).Range("G" & i).Value = upside
Next i
MsgBox "good"
Basically the code is suppose to read through a list of URLs on my spreadsheet and open those urls up in new tabs. It then finds the upside percentage put them in column G rows 3 to 16.
The error message that i just got was: The source was not found, but some or all event logs could not be searched. Innaccessible logs: security
Any help is appreciated
Related
Original Post: Here (New post as it started to get very clunky and dragged away from the issues at hand)
I am looking to automatically grab data from an excel CRM output and take certain values into a new sheet. I have had a bit of luck with my progress, but I am still struggling to adapt the code properly.
First Iteration of Code:
Sub Client_CRM()
Range("A4:A44,C4:C44,G4:H44").Select
Selection.Copy
Sheets("Output Sheet").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
Current code:
Sub Client_CRM()
Dim ClientStartRow As Long, ClientEndRow As Long
Dim Listed As Long
Set PortfolioRange = Worksheets("Client Paste").Range("A:M")
Set Listed = Worksheets("Client Paste").Range("A:A")
With Sheets("Client Paste")
Sheets("Output Sheet").Cells.Clear
Worksheets("Client Paste").Activate
ClientStartRow = .Range("A3").Row
':A").Find(What:="Listed", after:=.Range("A1")).Row
ClientEndRow = .Range("A:A").Find(What:="Totals", after:=.Range("A3"), LookIn:=xlValues, lookat:=xlPart, MatchCase:=False).Row
Range(ClientStartRow & ":" & ClientEndRow).Select
Selection.Columns(1).Copy
Sheets("Output Sheet").Select
Range("A3").Select
ActiveSheet.Paste
Sheets("Output Sheet").Range("B1:B70") = Application.VLookup(Listed, PortfolioRange, 8, False)
Sheets("Output Sheet").Range("C1:C70") = Application.VLookup(Listed, PortfolioRange, 3, False)
Sheets("Output Sheet").Range("D1:D70") = Application.VLookup(Listed, PortfolioRange, 7, False)
End With
End Sub
As you can see, I've slowly added and learnt more things throughout today.
What I am now looking to do is:
Find a better way to copy the columns over to the new sheet. **An issue that I have encountered is that maybe 1/10 CRM exports have an additional column, so the VLOOKUP can't accurately be used 100% - The CRM export has headers. Can I use some sort of code to grab these columns by value? They are exported and on Row 2. "Listed" "Quantity" "MV" "PW" are the 4 headings. Usually they are columns: 1,3,7,8 but in a rare instance they are 1,3,8,9...
Find a way to remove certain "blacklist" products. All products generally have a 3 part code that they are identified as. There are certain 3 part codes I do not want included and I want to be able to update this as time goes on. Ideally, I'd like to make a separate sheet with these codes and if they match to anything from the export, they aren't copied over...
Some product codes have 5 characters instead of 3, I'd like these ones to be coped in the same list but added to a separate list (Unsure if this is possible?)
Update:
Have worked out how to get the code to bring the 4 columns I want regardless of their order over.
Set PPSExport = Range("A2:M2")
For Each cell In PPSExport
If cell.Value = "Asset" Then
cell.EntireColumn.Copy
ActiveSheet.Paste Destination:=Worksheets("Output Sheet").Range("A:A")
End If
If cell.Value = "Quantity" Then
cell.EntireColumn.Copy
ActiveSheet.Paste Destination:=Worksheets("Output Sheet").Range("B:B")
End If
If cell.Value = "Market value" Then
cell.EntireColumn.Copy
ActiveSheet.Paste Destination:=Worksheets("Output Sheet").Range("C:C")
End If
If cell.Value = "Portfolio weight %" Then
cell.EntireColumn.Copy
ActiveSheet.Paste Destination:=Worksheets("Output Sheet").Range("D:D")
End If
Next cell
Sheets("Output Sheet").Select
End With
Thanks for any help,
I've already learnt so much already -- any pointers would be greatly appreciated :D
Yes, all of these things are possible. I will give a brief description on how to accomplish all of these things, but I recommend that you try to research how to do each of these tasks on your own before asking another question(s). It's also a good idea to keep the scope of your question limited. For example, you are asking about 3 loosely related items here. Yes, they are related to one another via your project, but in the general world of VBA programming, they are not. This will keep the conversation focused and easier to follow.
Find a better way to copy the columns over to the new sheet.
You made a great observation: your data is imported with headers. And your proposal is possible. You can certainly use the headers of a range (or table) to copy data. You could:
Iterate through all cells in the header row
If you come across one you are interested it, copy all of the data in that column to the new sheet
If you come across a column header you are not interested in, just skip it and move to the next one
Find a way to remove certain "blacklist" products.
This is possible, and your proposed solution sounds ideal to me. Keep a record of all blacklist values in a sheet, and reference that list when necessary.
Some product codes have 5 characters instead of 3, I'd like these ones
to be coped in the same list but added to a separate list
Certainly possible. Once you have your data:
Iterate through all of it and check how many characters are in the value
If there are 5, copy that data to a new location or store it somewhere
If there are not 5, move on to the next value
I'm attempting to automate something I do each day and I am not getting very far.
We run a report from an HR system each day and then compare the Id's to
1) a list of Id's we are working on this fortnight
2) a list of Id's we worked on last fortnight
3) the report that came out yesterday - so that any that weren't on the first two lists but were picked up by someone yesterday get marked.
I am writing this code in a separate spreadsheet so that this remains each day and the downloaded spreadsheet gets updated.
I thought this would be easy, but it is a couple of years since I've written much vba. But no matter what I try I can't seem to get it to read the third file.
All files are open already.
So the first file is the macro file, which just allows the other files to be selected.
The second file is the Excel document which comes from the HR system. This has "Empl ID" as the first column from A2 up to around to A500 at times.
The third file is the Excel document which details the ID's we are working on this fortnight and has "Emplid" as the first column.
With the code below I can't get the third Excel doc to work, I just get Run time error 9 : subscript out of range.
If I add a watch for Workbooks(txtMSR) I can see the sheet "MSR" as Item1 in Sheets and the name for that is MSR.
Any assistance would be most welcomed.
Dim txtWorkbook As String
Dim vLoop, vLoop2 As Integer
Dim vEID As String
Dim txtMSR As String
Dim txtWork2 As String
'Get workbook name less the .xls bit
'C13 has ps.xls in it
txtWorkbook = Left(Range("C13"), InStr(Range("C13"), ".xls") - 1)
'Next check who has the employees on this MSR
'Set counters to "zero"
vLoop = 2
vLoop2 = 2
'C7 has MSR Fortnight 20190419-20190502.xlsm in it
txtMSR = Left(Range("C7"), InStr(Range("C7"), ".xlsm") - 1)
Do Until Workbooks(txtWorkbook).Sheets("ps").Range("A" & vLoop).Text = ""
vPMKeyS = Workbooks(txtWorkbook).Sheets("ps").Range("A" & vLoop).Value
```
'The line below produces the error.
```
Do Until Workbooks(txtMSR).Sheets("MSR").Range("A" & vLoop2).Text = ""
If (vPMKeyS = Workbooks(txtMSR).Sheets("ps").Range("A" & vLoop2).Value) Then
Workbooks(txtWorkbook).Sheets("ps").Range("N1").Text = "Y"
End If
vLoop2 = vLoop2 + 1
Loop
vLoop = vLoop + 1
Loop
I don’t know AppleScript at all so thanks in advance for any help offered on this question.
I’m on my Macbook Pro laptop with the latest version of OSX installed. I have an Excel spreadsheet (I could use numbers if that makes it easier) with two columns.
FirstName Email
------------ -----------------
Ken blah#blah.com
Mike blahblah#blahblah.com
This is my customer list and I want to send them an email. Unfortunately I don’t have this list in an autoresponder so I have to send the emails one by one.
I know that I could whip up a PHP script to send the emails, however there are issues with email deliverability when doing it this way.
I want to write an AppleScript that processes my spreadsheet one row at a time and sends a message.
The message would be something like this:
Subject: How’s it going?
Hi Ken
It’s been a while since I sold you that defective widget from China.
If you need more defective elctronics I’m here for you. Just give me
a call at xxx-xxx-xxxx.
Sincerely
Ken
The AppleScript would read the name and email address from one row of the spreadsheet and send this email, filling in name and email address, using the standard apple mail program.
After sending the message I want the script to wait 60 seconds. Then send another email.
This needs to happen until a blank row is encountered.
My first question… Is this possible? If possible how do I do it?
Also is there a better way to do what I’m trying to do?
Thanks
There's probably a better way to do this, but couldn't you just copy the addresses as TSV or CSV?
set addresses to "Ken;blah#blah.com
Mike;blahblah#blahblah.com"
set text item delimiters to ";"
repeat with l in paragraphs of addresses
tell application "Mail"
tell (make new outgoing message)
set subject to "subject"
set content to "Hi " & text item 1 of l & linefeed & linefeed & "..."
make new to recipient at end of to recipients with properties {name:text item 1 of l, address:text item 2 of l}
send
delay (random number) * 100
end tell
end tell
end repeat
Try:
set {firstName, eAddress} to getData()
repeat with i from 1 to count firstName
tell application "Mail"
activate
set mymail to make new outgoing message at the beginning of outgoing messages with properties {subject:"How’s it going?"}
tell mymail
make new to recipient at beginning of to recipients with properties {address:item i of eAddress}
set content to "Hi " & item i of firstName & "
It’s been a while since I sold you that defective widget from China.
If you need more defective elctronics I’m here for you. Just give me
a call at xxx-xxx-xxxx.
Sincerely
Ken"
end tell
--show message window (otherwise it's hidden)
set visible of mymail to true
--bring Mail to front
activate
send mymail
end tell
end repeat
on getData()
set colA to {}
set colB to {}
tell application "Microsoft Excel"
activate
tell active sheet
set lastRow to first row index of (get end (last cell of column 1) direction toward the top)
repeat with i from 3 to lastRow
set end of colA to (value of range ("A" & i))
set end of colB to (value of range ("B" & i))
end repeat
end tell
end tell
return {colA, colB}
end getData
I have a workbook to do 'smart'-graphs on my expenses. It's been running for a year and there are now a lot of graphs and expenses. Excel now throws an out-of-resources error whenever I change anything or open the workbook. Thing is, I have lots of resources and its not using hardly any of them.
Win8 64bit w/ 8 core CPU and 32GB of ram
Office 2013 64bit
I have 2 sheets, the first sheet called Expenses has 3 columns [Date,Description,Amount] and about 1500 rows of data. The second sheet has a LOT (500 or so) of formulas that are all the same and aim to do "Sum all expenses between date X and Y where description matches -some needle-". The formula I have is this:
=
ABS(
SUMPRODUCT(
--(Expenses!A:A >= DATE(2011,12,1)),
--(Expenses!A:A < DATE(2012,1,1)),
--(ISNUMBER(FIND(C50,Expenses!B:B))),
Expenses!C:C
)
)
Can I give Excel more resources? (I'm happy for it to use all my ram, and chug my CPU for a few minutes).
Is there a more efficient way I can do this formula?
I understand that this formula is creating a large grid and masking my expenses list with it, and that for each formula this grid has to get created. Should I create a macro to do this more efficiently instead? If I had a macro, I would want to call it from a cell somehow like
=sumExpenses(<startDate>, <endDate>, <needle>)
Is that possible?
Thanks.
I had a similar problem where there were a few array formulas down about 150 rows and I got this error, which really baffled me because there really aren't that many formulas to calculate. I contacted our IT guy and he explained the following, some of which I understand, most of which I don't:
Generally when the computer tries to process large amounts of data, it uses multi-threaded calculation, where it uses all 8 processors that the computer tricks itself into thinking it has. When multi-threaded calculation is turned off, the computer doesn't throw the 'Excel ran out of resources...' error.
To turn off multi-threaded calculation, got to the 'File' tab in your Excel workbook and select 'Options'. On the right side of the box that appears select 'Advanced' and scroll down to the heading 'Formulas'. Under that heading is a check box that says 'Enable multi-threaded calculation'. Untick it, then select 'OK' and recalculate your formulas.
I had a go at creating a function that hopefully replicates what your current equation does in VBA with a few differences. Since I don't know the specifics of your second sheet the caching might not help at all.
If your second sheet uses the same date range for all calls to sumExpenses then it should be a bit quicker as it pre-sums everything on the first pass, If your date range changes throughout then its just doing a lot of work for nothing.
Public Cache As Object
Public CacheKey As String
Public Function sumExpenses(ByVal dS As Date, ByVal dE As Date, ByVal sN As String) As Variant
Dim Key As String
Key = Day(dS) & "-" & Month(dS) & "-" & Year(dS) & "_" & Day(dE) & "-" & Month(dE) & "-" & Year(dE)
If CacheKey = Key Then
If Not Cache Is Nothing Then
If Cache.Exists(sN) Then
sumExpenses = Cache(sN)
Exit Function
End If
Set Cache = Nothing
End If
End If
CacheKey = Key
Set Cache = CreateObject("Scripting.Dictionary")
Dim Expenses As Worksheet
Dim Row As Integer
Dim Item As String
Set Expenses = ThisWorkbook.Worksheets("Expenses")
Row = 1
While (Not Expenses.Cells(Row, 1) = "")
If Expenses.Cells(Row, 1).Value > dS And Expenses.Cells(Row, 1).Value < dE Then
Item = Expenses.Cells(Row, 2).Value
If Cache.Exists(Item) Then
Cache(Item) = Cache(Item) + Expenses.Cells(Row, 3).Value
Else
Cache.Add Item, Expenses.Cells(Row, 3).Value
End If
End If
Row = Row + 1
Wend
If Cache.Exists(sN) Then
sumExpenses = Cache(sN)
Else
sumExpenses = CVErr(xlErrNA)
End If
End Function
Public Sub resetCache()
Set Cache = Nothing
CacheKey = ""
End Sub
There could be many causes of this. I just wish Excel would tell us which one (or more) of the 'usual suspects' is committing the offence of RAM hogging at this time.
Also look for
Circular references
Fragmented Conditional formatting (caused by cutting, pasting, sorting, deleting and adding cells or rows.
Errors resulting in #N/A, #REF, #DIV/0! etc,
Over-use of the volatile functions TODAY(), NOW(), etc.
Too many different formats used
... in that order
While you're there, check for
Broken links. A formula relying on a fresh value from external data could return an error.
Any formulas containing #REF!. If your formulas are that messed these may well be present also. They will not cause an error flag but may cause some unreported errors. If your formulas are satisfied by an earlier condition the part of the formula containing #REF! will not be evaluated until other conditions prevail.
Fragmented conditional formatting was the case for me.
Older versions of the same workbook did not have an issue. Today, I cut/pasted many cells and the issue started occurring.
Removing the columns where I was cutting/pasting resolved the issue for me.
This is difficult to diagnose since conditional formatting does not immediately standout like normal formulas.
Walk with me for a moment.
I have built an Access application to manage data for an internal project at my company. One of the functions of this application is queries the database, then outputs the queries to an Excel spreadsheet, then formats the spreadsheet to spec.
One of the cells of the output is a large amount of text from a Rich Text Memo field in the database. When the rich text is sent to Excel it carries with it HTML tags indicating bold or italic, so for the output I have to add the formatting and remove the tags.
Here is an example of the text I need to format (this text is in a single cell):
For each participant, record 1 effort per lesson delivered
• Time Spent = # minutes spent on lesson
<strong>OR</strong>
For each participant, record 1 effort per month
• Time Spent = total # minutes spent on lessons that month
<strong>Note:</strong> Recording 1 effort per lesson is recommended but not required
<strong>Note:</strong> Use groups function in ABC when appropriate (see <u>Working With Groups</u> in ABC document library on the ABC portal)
I have a three neat little recursive functions for formatting the text, here is the bolding function:
Function BoldCharacters(rng As Range, Optional ByVal chrStart As Long)
'This will find all the "<strong></strong>" tags and bold the text in between.
Dim tagL As Integer
tagL = 8
rng.Select
If chrStart = 0 Then chrStart = 1
b1 = InStr(chrStart, ActiveCell.Value, "<strong>") + tagL
If b1 = tagL Then Exit Function
b2 = InStr(b1, ActiveCell.Value, "</strong>")
ActiveCell.Characters(Start:=b1, Length:=b2 - b1).Font.Bold = True
'Remove the tags
'ActiveCell.Characters(Start:=1, Length:=1).Delete
'ActiveCell.Characters(Start:=b2 - tagL, Length:=tagL + 1).Delete
'Recursion to get all the bolding done in the cell
Call BoldCharacters(ActiveCell, b2 + tagL + 1)
End Function
Now here's the issue. This formats the text nicely. But the "ActiveCell.Characters.Delete" method fails when I attempt to use it to remove the tags because the cell contains more than 255 characters. So I can't use the delete method.
And when I do this:
With xlApp.Selection
.Replace what:="<strong>", replacement:=""
The tags are all removed, but the formatting is all destroyed! So what's the point!?
I'm looking for a way of formatting my text and removing the tags. I'm considering taking the large bit of text and 'chunking' it up into a number of cells, processing the formatting and re-assembling, but that sounds difficult, prone to error, and might not even work.
Any ideas!?
Thanks!
You might want to remove the formatting before exporting the data to Excel. At the same time that you remove the formatting, store the formatting information (location, length, style) to a data structure. After you export the "plain text" data you could then iterate over your structure and apply the formatting in Excel. This could be a time consuming process depending upon how many records you plan on exporting at a given time, but it would remove the limitation imposed by Excel.
If it's well formed html (ie it always has closing tags) then you could use a regular expression.
Dim data As String
data = "For each participant, record 1 effort per lesson delivered • Time Spent = # minutes spent on lesson <strong>OR</strong> For each participant, record 1 effort per month • Time Spent = total # minutes spent on lessons that month <strong>Note:</strong> Recording 1 effort per lesson is recommended but not required <strong>Note:</strong> Use groups function in ABC when appropriate (see <u>Working With Groups</u> in ABC document library on the ABC portal)"
Dim r As New RegExp
r.Pattern = "<(.|\n)*?>"
r.Global = True
Debug.Print r.Replace(data, "")
To use the RegExp object, set a reference to Microsoft VBScript Regular Expressions 5.5.
hth
Ben
Something along these lines might be useful:
Sub DoFormat(rng As Range)
Dim DataObj As New MSForms.DataObject
Dim s As String, c As Range
For Each c In rng.Cells
s = "<html>" & Replace(c.Value, " ", " ") & "</html>"
DataObj.SetText s
DataObj.PutInClipboard
c.Parent.Paste Destination:=c
Next c
End Sub
You'll need a reference to "Microsoft Forms 2.0 Object Library"