I Have practically no experience in VBA, but I need some help getting the following.
I have a Table that with a Click(), should have a line added, with the Selected Slicer values.
There are 5 Slicers on my worksheet, and I would need to return all 5 selections. (If a slicer is not selected, a msgbox should say "Select Slicers".
Please take into account this is the slicer of a table, not PivotTable
At the moment I have the following :
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
'Modified 1-16-18 1:45 AM EST
Dim i As Long
Dim Lastrow As Long
Dim Project As String
Dim Werkpost As String
Dim Team As String
Dim SlicerV
Lastrow = Sheets("Facade-Materiaal").Cells(Rows.Count, "A").End(xlUp).Row + 1
Project = "VALUE OF SLICER Slicer_Project11"
Werkpost = "VALUE OF SLICER Slicer_Project12"
Team = "VALUE OF SLICER Slicer_Project13"
Zone = "VALUE OF SLICER Slicer_Project14"
LS = "VALUE OF SLICER Slicer_Project15"
With Sheets("Facade-Materiaal")
.Cells(Lastrow, 1).Value = Project
.Cells(Lastrow, 2).Value = Werkpost
.Cells(Lastrow, 3).Value = Team
.Cells(Lastrow, 4).Value = Zone
.Cells(Lastrow, 5).Value = LS
End With
Application.ScreenUpdating = True
End Sub
I cannot seem to be able to full up the values between brackets, Any help ?
Robbe
Related
I have successfully scripted VBA code for summarizing and formatting a large set of data within a sheet. The script is successful when the macro is run on the next sheet I select. When tasked to apply the script across all sheets in the workbook, the modified script completes the summarizations for each sheet, but only formats the first. We tried to troubleshoot in my data class, but to no avail. This is an image of what it is supposed to look like.
My script for the whole workbook:
Sub tickerdata_all_ws()
'define variables
dim ws as Worksheet
Dim ticker As String
Dim stock_vol As Long
Dim yrclose As Double
Dim yrchange As Double
Dim yrvar As Double
Dim i As Long
Dim sumrow As Integer
Dim lastrow As Long
lastrow = ActiveSheet.UsedRange.Rows.Count
for each ws in Worksheet
'create the column headers
ws.Range("H1").Value = "Ticker"
ws.Range("J1").Value = "Yearly Change"
ws.Range("K1").Value = "Percent Change"
ws.Range("L1").Value = "Total Stock Volume"
'which row our summaries will be placed for above columns
sumrow = 2
'the loop checks each iteration until the last row
For i = 2 To lastrow
'we need to capture the price of the ticker if it is the first of its year
Dim firstprice As Boolean
If firstprice = False Then 'false is the default boolean value, so this statement is true
Dim yropen As Double
yropen = ws.Cells(i, 3).Value
firstprice = True 'we have captured the opening price of the year for the ticker
End If
'now we can check if we are in the same ticker value
If ws.Cells(i + 1, 1).Value <> ws.Cells(i, 1).Value Then
'this should happen when the cell values are finally different / capture all the values
ticker = ws.Cells(i, 1).Value
stock_vol = ws.Cells(i, 7).Value
yrclose = ws.Cells(i, 6).Value
yrchange = yrclose - yropen
If yropen <> 0 Then 'this prevents dividing by zero which will result in overflow error 6
yrvar = (yrclose - yropen) / yrclose
Else
yrvar = 0
yrchange = 0
End If
'insert values into the summary
ws.Cells(sumrow, 9).Value = ticker
ws.Cells(sumrow, 10).Value = yrchange
ws.Cells(sumrow, 11).Value = yrvar
ws.Cells(sumrow, 12).Value = stock_vol
sumrow = sumrow + 1 'sets the stage for the next set of data into row 3
stock_vol = 0 'resets vol for the next ticker
firstprice = False 'allows the next 'first' open price of the loop to be captured
End If
Next i 'finish i iteration of the loop
ws.Range("K:K").NumberFormat = "0.0%" 'aesthetic preference
'format columns colors
Dim colJ As Range
Dim Cell as Range
Set colJ = Range("J2", Range("J2").End(xlDown)) 'from J2 to the last cell entry
For Each Cell In colJ
If Cell.Value > 0 Then
Cell.Interior.ColorIndex = 50
Cell.Font.ColorIndex = 2
ElseIf Cell.Value < 0 Then
Cell.Interior.ColorIndex = 30
Cell.Font.ColorIndex = 2
Else
Cell.Interior.ColorIndex = xlNone 'this really serves no purpose
End If
Next
next ws
End Sub
I am sure there are other, much better ways to accomplish this, but as a novice, this is my code salad, and I'd appreciate any help as to why it is not formatting the other three sheets.
Excel for Mac user, though I've run it via Parallels as well.
Set colJ = Range("J2", Range("J2").End(xlDown)) 'from J2 to the last cell entry
here you get range for active sheet.
Change to:
Set colJ = ws.Range("J2", ws.Range("J2").End(xlDown))
I want to paste certain rows into a certain sheet if a string is entered into a textbox.
I have is a userform that I'd like to paste entries into Month specific sheets based on the date textbox.
I can copy to one specific sheet, but I'd like to auto sort into the appropriate Month sheet based on the value entered in DT.value.
Private Sub Submit_Click()
Dim ws As Worksheet
Dim LastRow As Long
If DT.Value = "nov" Then
Set ws = ThisWorkbook.Worksheets("NOV")
Else
If DT.Value = "dec" Then
Set ws = ThisWorkbook.Worksheets("DEC")
Else
If DT.Value = "Jan" Then
Set ws = ThisWorkbook.Worksheets("JAN")
Else
If DT.Value = "Feb" Then
Set ws = ThisWorkbook.Worksheets("FEB")
Else
If DT.Value = "mar" Then
Set ws = ThisWorkbook.Worksheets("MAR")
Else
If DT.Value = "Apr" Then
Set ws = ThisWorkbook.Worksheets("APR")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
'other code that works below.
With this code I end up with Type Mismatch or nothing gets copied.
I'd like the user to enter a date in the dt.value box and the data paste to the appropriate sheet based on that value.
It depends on how you have named your tabs and how your date is imputed in the textbox.
But if you are using mar and MAR, here is a simple code to assign the worksheet variable using the text in the userform textbox.
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(Me.DT.Text)
Update to basic code:
Private Sub CommandButton1_Click()
'Check if the textbox has a valid date
If IsDate(Me.DT.Text) Then
Me.DT.Text = Format(CDate(Me.DT.Text), "mmm") 'Format as abrivated month
'Define and Assign worksheet and newRow variables
Dim ws As Worksheet, newRow As Long
Set ws = ThisWorkbook.Worksheets(Me.DT.Text)
newRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
With ws 'When writing other textbox values to the worksheet; change TextBox# as required
.Cells(newRow, 1).Value = Me.TextBox1.Text
.Cells(newRow, 2).Value = Me.TextBox2.Text
.Cells(newRow, 3).Value = Me.TextBox3.Text
.Cells(newRow, 4).Value = Me.TextBox4.Text
End With
Application.Goto ws.Range("A1"), Scroll:=True 'Set the focus to the first cell on the worksheet
Else 'If a valid date is not entered display a message box
MsgBox "Please enter a valid date"
Cancel = True
End If
End Sub
I am making a project for my small restaurant in excel VBA, I have designed a receipt and transfer form to sell to customers or transfer items to another department (departments: Store, Kitchen and Sales Point). I have a worksheet "Inventory" which contains all items from all departments their prices and available quantities.
However, I am having trouble with updating the available quantities automatically when the "close and save" or "Print" button is clicked i.e when items are sold or transferred.
Here is the code I have tried.
Sub updateinventory()
Dim invlastrow, reclastrow As Long
Dim ws1, ws2 As Worksheet
Dim itemName, itemQty, a, b
Set ws1 = ThisWorkbook.Worksheets("Inventory")
Set ws2 = ThisWorkbook.Worksheets("Receipt")
invlastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
reclastrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox Cells(reclastrow, 3).Value
Do While Cells(invlastrow, 3).Value <> ""
itemName = Cells(invlastrow, 3).Value
For b = 19 To reclastrow
If itemName = Cells(reclastrow, 1) Then
MsgBox (itemName)
itemQty = Cells(invlastrow, 8).Value
itemQty = itemQty - Cells(reclastrow, 3)
End If
Next b
'MsgBox (itemQty)
End If
Next a
End Sub
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.
I have edited this question from initial posting since I realized that no macro will activate the Worksheet_change function.
I am using a UserForm to create a macro to edit a cell. Then I want the Worksheet to take the value from one cell and create values in other cells. This works manually, but not in via macro!
From the UserForm:
Sub WriteOperatingFunds(dates, description, money)
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets("OperatingFunds")
'find first empty row in database
irow = ws2.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
ws2.Cells(irow, 1).value = dates
ws2.Cells(irow, 2).value = description
ws2.Cells(irow, 3).value = money
End Sub
And from the worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim change As String
Dim chngRow As Long
Dim IncRow As Long
Dim ExpRow As Long
Dim TotRow As Long
Dim Income As Long
Dim Expense As Long
Dim Total As Long
Set ws = ThisWorkbook.Worksheets("OperatingFunds")
TotRow = ws.Cells(ws.Rows.Count, 5).End(xlUp).Row 'finds bottom of 'Total' Column
'looks for target in range
If Not Application.Intersect(Target, ws.Range("C3", ws.Cells(TotRow + 1, 4))) Is Nothing Then
change = Target.Address(False, False)
chngRow = ws.Range(change).Row
'Get the last rows of range columns
IncRow = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
ExpRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row
Application.EnableEvents = False 'to prevent endless loop & does not record changes by macro
'if Total column is empty
If ws.Cells(chngRow, 5) = "" Then
Income = Application.WorksheetFunction.Sum(ws.Range("C3", ws.Cells(TotRow + 1, 3)))
Expense = Application.WorksheetFunction.Sum(ws.Range("D3", ws.Cells(TotRow + 1, 4)))
Total = Income + Expense
ws.Cells(chngRow, 5) = Total
'if total column is not empty (i.e. needs to be rewritten)
ElseIf ws.Cells(chngRow, 5) <> "" Then
Income = Application.WorksheetFunction.Sum(ws.Range("C3", ws.Cells(chngRow, 3)))
Expense = Application.WorksheetFunction.Sum(ws.Range("D3", ws.Cells(chngRow, 4)))
Total = Income + Expense
ws.Cells(chngRow, 5) = Total
End If
Else
MsgBox "Else is thrown."
Exit Sub
End If
Application.EnableEvents = True 'so that future changes can be read
End Sub
I don't want to be pretentious to answer my own question, but my friend helped me find the solution, and maybe this will help others with a similar problem.
The key factor is that I'm using a button on UserForm to write data to the cell. It's not actually "changing" the cell when I write "Cells(#,#) = value". In my code, I needed to turn the Sub public and then
Call ThisWorkbook.Worksheets("worksheetname").Worksheet_Change(Target.address)
This made everything work!
His example to help me: https://bytes.com/topic/access/answers/767919-trigger-click-event-button-another-form