for months I've been using a macro created by a collegue that worked flawlessly, but for some reason It stopped 2 days ago, I'm a bit unfamiliar with programming (please excuse me) but it looks like something happened to the Bloomberg commands that were used to extract data (price of securities listed)
this is the error message I get:
and this is the macro until the line that it stops
Option Explicit
Option Base 1
Sub update()
Dim wbk As Workbook 'This workbook
Set wbk = ThisWorkbook
Dim path As String
path = wbk.path
Dim oBBG As New BLP_DATA_CTRLLib.BlpData
Dim date_string As String
date_string = CStr(CLng(Now()))
Dim row As Long
Dim col As Long
Dim vtSecurities As Variant
Dim vtFields As Variant
Dim vtData As Variant
Dim d1 As Date
Dim tmp As String
With wbk.Sheets(1)
.Activate
.Cells(1, 1) = "TICKER"
.Cells(1, 2) = "LAST_PRICE"
.Cells(1, 3) = "DESCRIPTION"
.Cells(1, 4) = "CURRENCY"
.Cells(1, 5) = "PRICE_CLOSE_DATE"
.Cells(1, 6) = "LAST_UPDATE"
.Cells(1, 7) = "PX_CLOSE_DT"
d1 = Now()
.Cells(1, 8) = "Last Refresh"
.Cells(1, 9) = d1
.Cells(5, 9) = "Macro Guideline"
.Cells(6, 9) = "1- Copy Ticker in first column"
.Cells(7, 9) = "2- Click on the update button"
.Cells(8, 9) = "3- Ticker not found will be move into the Deleted Table. They will not appear in the Bloomberg Extract table."
'Find the last non-blank cell in column A(1)
row = .Cells(Rows.Count, 1).End(xlUp).row
'Find the last non-blank cell in row 1
col = .Cells(1, Columns.Count).End(xlToLeft).Column
vtSecurities = WorksheetFunction.Transpose(.Range(Cells(2, 1), Cells(row, 1)))
vtFields = Array("PX LAST", "Name", "CRNCY", "PX_LAST", "LAST_UPDATE_DT", "PX_CLOSE_DT")
**vtData = oBBG.BLPSubscribe(vtSecurities, vtFields)**
I'm sorry if anything is missing, I've verified and the Bloomberg data type library is in the checked references.
thanks!
FYI, Bloomberg updated their Desktop API. All the old API calls won't work. You will need to change your code to the new API, or I'm told that Bloomberg can revert your login to the old API for an additional month if you ask them.
Related
first time asker here.
I found a nice VBA code to copy the same specific cells from multiple worksheets into a mastersheets and actually does its job (i don't remember where I founf it originally). The only small issue is that it starts to input the data from cell A2, while I would like it to start from cell A4.
Here is the code:
Sub ListFB()
Sheets("Master").Range("A4").Value = "Sheet Name"
For I = 1 To ThisWorkbook.Worksheets.Count
If Sheets(I).Name <> "RiassuntoTEST" Then
Sheets("Master").Cells(I, 1).Value = Sheets(I).Range("B2").Value
Sheets("Master").Cells(I, 2).Value = Sheets(I).Range("C2").Value
Sheets("Master").Cells(I, 3).Value = Sheets(I).Range("C10").Value
Sheets("Master").Cells(I, 4).Value = Sheets(I).Range("C11").Value
Sheets("Master").Cells(I, 5).Value = Sheets(I).Range("C15").Value
Sheets("Master").Cells(I, 6).Value = Sheets(I).Range("C16").Value
Sheets("Master").Cells(I, 7).Value = Sheets(I).Range("C20").Value
Sheets("Master").Cells(I, 8).Value = Sheets(I).Range("C21").Value
Sheets("Master").Cells(I, 9).Value = Sheets(I).Range("C25").Value
Sheets("Master").Cells(I, 10).Value = Sheets(I).Range("C26").Value
Sheets("Master").Cells(I, 11).Value = Sheets(I).Range("C29").Value
Sheets("Master").Cells(I, 12).Value = Sheets(I).Range("C30").Value
Sheets("Master").Cells(I, 13).Value = Sheets(I).Range("C33").Value
Sheets("Master").Cells(I, 14).Value = Sheets(I).Range("C34").Value
End If
Next I
End Sub
What I think it does is take value B2 from Sheet I and copy it to A2 of the mastersheet, then take C2 and copy it to B2, until it has all the required data from that sheet into the same rows, then goes to the next sheet and puts the data in the next rows. As I said above, I would like that this whole process starts from A4 instead of A2.
I am fairly new to this kind of stuff so any input and help is appreciated.
Also, does the row
Sheets("Master").Range("A4").Value = "Sheet Name"
Do anything for my purpose at all?
Thank you!
First issue:
Sheets("RiassuntoTEST").Cells(I, 1).Value
Cells holds what is known as an R1C1 reference. Meaning Row number, Column number. Since this line I = 1 To ThisWorkbook.Worksheets.Count counts from 1 to the number of worksheets you have, this will start pasting in row 1, column 1, also known as cell A1. If you want to up this to cell A4 instead, you will need to increase this by 3 like so:
Sheets("RiassuntoTEST").Cells(I + 3, 1).Value
You will need to do this on every line.
Second issue:
Also, does the row
Sheets("RiassuntoTEST").Range("A4").Value = "Nome Foglio"
Do anything for my purpose at all?
No, it does not, as stated before, your code will (now) start pasting at cell A4, so as soon as the second block starts running, this is overwritten.
I rewrote your code in such a way as to enable you to make all the amendments you might want - perhaps with a little help from the comments I inserted between the lines of code.
Option Explicit
Sub UpdateMaster()
' Variatus #STO 23 Jan 2020
Dim Wb As Workbook
Dim MasterWs As Worksheet
Dim Ws As Worksheet
Dim SourceCell() As String
Dim Rt As Long ' target row
Dim Ct As Long ' target column
Dim i As Integer
Set Wb = ThisWorkbook ' you might specify another workbook
' specify the Master worksheet here
Set MasterWs = Wb.Worksheets("TEST")
' list all the source cells here
SourceCell = Split("B2,C2,C10,C11,C15,C16,C20,C21,C25,C26,C29,C30,C33,C34", ",")
Rt = 4 ' set first row to write to here
With MasterWs
' keep contents in rows 1 to 3 (incl title)
.Range(.Cells(Rt, 1), .Cells(.Rows.Count, "A").End(xlUp) _
.Offset(0, UBound(SourceCell) + 1)) _
.ClearContents
End With
Application.ScreenUpdating = False ' speeds up execution
For i = 1 To Wb.Worksheets.Count
Set Ws = Wb.Worksheets(i)
If Not Ws Is MasterWs Then
For Ct = 0 To UBound(SourceCell)
MasterWs.Cells(Rt + i - 1, Ct + 1) = Ws.Range(Trim(SourceCell(Ct))).Value
Next Ct
End If
Next i
Application.ScreenUpdating = True
End Sub
I need to pull a date in CYYMMDD Text format into DD/MM/YYYY Date format
I think I'm missing a step here as I'm not getting the prompts when typing in ".Formula" etc
I'm also sure there's a better way to do this without pasting the value in first
Dim ws As Worksheet, lastRow As Long
Set ws = Worksheets("SALEREP17")
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
With ws.Range("B" & lastRow)
.Copy Destination:=Worksheets("PAGE 4-COMMERCIALS").Cells(17, 3)
End With
Set ws = Worksheets("PAGE 4-COMMERCIALS")
With Cells(17, 2)
.Formula = "=RIGHT(RC[1],2)&""/""&MID(RC[1],4,2)&""/20""&MID(RC[1],2,2)"
.Value = .Value
End With
So what this done is pulls the bottom row from the "date last changed" from our ODBC connection. It then pastes into the report tab and converts it into a date and removes the formula
Then I would just go on to delete the text in (17, 3) but there must be a better way than this?
This should do what you need:
Dim ws As Worksheet, lastRow As Long, c As Range
Set ws = Worksheets("SALEREP17")
With ws
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set c = ws.Cells(lastRow, 2)
Worksheets("PAGE 4-COMMERCIALS").Cells(17, 3).Value = DateSerial(Mid(c, 2, 2), Mid(c, 4, 2), Mid(c, 6, 2))
End With
Note: the (1000 * Left(c, 1)) part isn't strictly necessary, unless you want the code to work for several hundred years..
range("a1").value=dateserial(mid(x,2,2),mid(x,4,2),mid(x,6,2)) where x is your date.
I am trying to transfer stock transactions from a transaction workbook to another book that has the formatting i want. I want to be able to change the client name and stock at the top of the code so it makes it easier to run for multiple people. the problem is that when i run this it only returns one date in my formatted worksheet when i can see that there are 3 stock trades for the given ticker with different dates in the transaction book. it seems like the FOR function isn't looping through all the rows in the transaction book but im not sure why
Sub SortTransactionData()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks("Allen Smith Transactions.xlsx")
Set ws = wb.Sheets("Sheet1")
Dim wb1 As Workbook
Dim ws1 As Worksheet
Set wb1 = Workbooks("Allen Smith HI.xlsm")
Set ws1 = wb1.Sheets("MO")
Dim ticker As String
ticker = ws1.Range("A2")
Dim a As Integer
a = ws.Cells(Rows.Count, 6).End(xlUp).Row
Dim b As Integer
b = Application.WorksheetFunction.CountIf(ws1.Range("B1:B7"), "*")
For i = 2 To a
'copy date for stock transaction'
If ws.Cells(i, 6).Value = ticker Then
ws1.Cells(b + 1, 2).Value = ws.Cells(i, 1)
End If
Next
End Sub
As mentioned in comments, the problem is that cell ws1.Cells(b + 1, 2) never changes, so you keep overwriting old values as you go through your loop
Change your code to increment the index, b, each time through the loop:
For i = 2 To a
'copy date for stock transaction'
If ws.Cells(i, 6).Value = ticker Then
ws1.Cells(b + 1, 2).Value = ws.Cells(i, 1)
b = b + 1
End If
Next i
I have a master price worksheet (Test Price) with product name (col A) and price (col B). I want to create a macro that when you click a button it will update the prices through the entire workbook. The previous person in my position already created a MOD that will update prices throughout the WB if it is changed in one WS. I am trying to link the master list to that code. So loop through the list and update one sheet which will use the existing mod to update all other sheets. Can anyone please help with this?
This is the code that updates the sheets, I need to link the master price list to this:
Sub ChangePrice(row As String, price As String)
Dim cropVal As String: cropVal = Cells(row, 2).Value ' inefficient
Dim LastRow As Long
For Each ws In ActiveWorkbook.Worksheets
'simple check for division in A3 (stronger check may be needed)
If ws.Cells(3, 1).Value = "Division:" Then
LastRow = ws.Range("A" & Rows.count).End(xlUp).row
' starts in row 12, though data starts in 13
For i = 12 To LastRow
'check column 2 if crop is the same
If ws.Cells(i, 2).Value = cropVal Then
'if so, change its price in column 10
ws.Cells(i, 10).Value = price
'this handles situations where the symbol is attached
ElseIf ws.Cells(i, 2).Value = cropVal & "®" Then
ws.Cells(i, 10).Value = price
End If
Next i
End If
Next ws
End Sub
You could create a dictionary of the values and then pass the dictionary to the module. You would need to add a For Each loop to your master sheet to find the row with the product for each specific worksheet.
Sub CropValFind()
Dim ProdCol As Range, Cell As Range, PriceCol As Range
Set ProdCol = 'Your product column range here
Set PriceCol = 'Your Price Column range here
For Each Cell in ProdCol
Call ChangePrice(Cell.Value, CreateDictFromColumns("MasterSheetName", ProdCol.Column, PriceCol.Column))
Next
End Sub
Assuming your product and price columns are adjacent to each other and the values are strings:
Pulled from https://stackoverflow.com/a/33523909/10462532
Function CreateDictFromColumns(sheet As String, keyCol As String, valCol As String) As Dictionary
Set CreateDictFromColumns = New Dictionary
Dim rng As Range: Set rng = Sheets(sheet).Range(keyCol & ":" & valCol)
Dim i As Long
Dim lastCol As Long '// for non-adjacent ("A:ZZ")
lastCol = rng.Columns.Count
For i = 1 To rng.Rows.Count
If (rng(i, 1).Value = "") Then Exit Function
CreateDictFromColumns.Add rng(i, 1).Value, rng(i, lastCol).Value
Next
End Function
Then your ChangePrice Sub would look something like this.
Sub ChangePrice(row As String, price As Dictionary)
Dim cropVal As String: cropVal = row
Dim LastRow As Long
For Each ws In ActiveWorkbook.Worksheets
'simple check for division in A3 (stronger check may be needed)
If ws.Cells(3, 1).Value = "Division:" Then
LastRow = ws.Range("A" & Rows.count).End(xlUp).row
' starts in row 12, though data starts in 13
For i = 12 To LastRow
'check column 2 if crop is the same
If ws.Cells(i, 2).Value = cropVal Then
'if so, change its price in column 10
ws.Cells(i, 10).Value = price(row)
'this handles situations where the symbol is attached
ElseIf ws.Cells(i, 2).Value = cropVal & "®" Then
ws.Cells(i, 10).Value = price(row)
End If
Next i
End If
Next ws
End Sub
A great resource to learn the in's and outs of dictionaries can be found here.
Ideally, what i need is to email the sepcified range rows with "x" in their column, i tried a code and it's working grand but the only problem is that it's sending 3 emails for 3 rows, but i want to send all the records in one email. I was able to do that using a vba code that converts the selected range in HTML and email it out. Now i want to automate the selection part.So basically i need to select the specified range of any row which have "x" in first column.
I tried a code but it's only selecting the last row that contains "x".
Link for the image showing what i am exactly looking for - https://imgur.com/a/Zq97ukL
Sub Button3_Click()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim Sheets As Worksheet
Dim r1 As Range
lRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lRow
If (Cells(i, 1)) = "x" Then 'change this range
Set r1 = Range(Cells(i, 2), Cells(i, 4))
r1.Select
On Error Resume Next
On Error GoTo 0
Cells(i, 10) = "Selected " & Date + Time 'column J
End If
Next i
ActiveWorkbook.Save
End Sub
jsheeran posted the bulk of this, but deleted his answer because it wasn't finished.
As previously stated, there is probably no reason to select anything.
Sub Button3_Click()
Dim lRow As Long
Dim i As Long
Dim toDate As Date
Dim Sheets As Worksheet
Dim r1 As Range
lRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lRow
If Cells(i, 1).Value = "x" Then
Set r1 = Union(IIf(r1 Is Nothing, Cells(i, 2).Resize(, 3), r1), Cells(i, 2).Resize(, 3))
Cells(i, 10).Value = "Selected " & Date + Time
End If
Next i
If Not r1 Is Nothing Then r1.Select
ActiveWorkbook.Save
End Sub