I'm looking for an elegant solution to trigger an event for opening the workbook as well as opening different worksheets. I don't need seperate operations for each worksheet: they all trigger the same method.
I know I can use the events Workbook_Activate / Workbook_Open and Workbook_SheetActivate at the same time but I don't know if this is 'the official way' to do it. Perhaps there's a way to do this with one event.
I was also wondering if it is relevant in this matter where I put the code. I now have all the code inside "ThisWorkbook" and not in a "Module"...
Here is some code I developed a while ago to ensure that a report my managers use is always opened to the correct tab based on time of day. I house this code in the "ThisWorkbook" module of my VBA.
Sub Workbook_Open()
' Set The Office
Dim begin As String
Dim myNum As String
Dim myNum1 As String
Dim TheDate As String
' Set Date
TheDate = Format(DateTime.Now(), "mm-dd-yy")
Sheets("MORNING").Range("H3").Value = TheDate
Sheets("AFTERNOON").Range("G3").Value = TheDate
'Sheets("EVENING").Range("G3").Value = TheDate
' Select Sheet Based on Time of Day
If Time >= 0.1 And Time < 0.5 Then
Sheets("MORNING").Select
Range("A53").Value = "Report completed by:"
Range("C53").Value = Application.UserName
Range("I53").Value = Date & " " & Time
Range("B27").Select
Call Populate 'Your next code
ElseIf Time >= 0.5 And Time < 0.75 Then
Sheets("AFTERNOON").Select
Range("A54").Value = "Report completed by:"
Range("C54").Value = Application.UserName
Range("I54").Value = Date & " " & Time
Range("C28").Select
Call Populate 'Your next code
End If
End Sub
Notice that I have also added code to auto sign the form output with the userid and update date and time. I hope this helps.
Like others have mentioned: there's no single event to do this. There might be workarounds, but I prefer just using _Open and _SheetActive in that case. Thanks everyone!
Related
I'm currently working on a macro for outlook, to create meetings from a specific date.
My macro can create, modify, delete meetings.
I would like to check if there are conflicts between meetings when I create one.
I've tried to use AppointmentItem.Conflicts property, but I couldn't have any good results.
Thank you for your help.
D
You can use the Recipient.FreeBusy method which returns free/busy information for the recipient. This following VBA example returns a string of free/busy information with one character for each hour (complete format).
Set myRecipient = myNameSpace.CreateRecipient("Nate Sun")
myFBInfo = myRecipient.FreeBusy(#02/05/2022#, 60, True)
To get information for the current user you may use the NameSpace.CurrentUser property which returns the currently logged-on user as a Recipient object, so may call the FreeBusy method on it.
Note, in case of Exchange accounts you may find the ExchangeUser.GetFreeBusy method helpful. It returns a string representing the availability of the ExchangeUser for a period of 30 days from the start date, beginning at midnight of the date specified.
Sub GetManagerOpenInterval()
Dim oManager As ExchangeUser
Dim oCurrentUser As ExchangeUser
Dim FreeBusy As String
Dim BusySlot As Long
Dim DateBusySlot As Date
Dim i As Long
Const SlotLength = 60
'Get ExchangeUser for CurrentUser
If Application.Session.CurrentUser.AddressEntry.Type = "EX" Then
Set oCurrentUser = _
Application.Session.CurrentUser.AddressEntry.GetExchangeUser
'Get Manager
Set oManager = oManager.GetExchangeUserManager
If oManager Is Nothing Then
Exit Sub
End If
FreeBusy = oManager.GetFreeBusy(Now, SlotLength)
For i = 1 To Len(FreeBusy)
If CLng(Mid(FreeBusy, i, 1)) = 0 Then
'get the number of minutes into the day for free interval
BusySlot = (i - 1) * SlotLength
'get an actual date/time
DateBusySlot = DateAdd("n", BusySlot, Date)
'To refine this function, substitute actual
'workdays and working hours in date/time comparison
If TimeValue(DateBusySlot) >= TimeValue(#8:00:00 AM#) And _
TimeValue(DateBusySlot) <= TimeValue(#5:00:00 PM#) And _
Not (Weekday(DateBusySlot) = vbSaturday Or _
Weekday(DateBusySlot) = vbSunday) Then
Debug.Print oManager.name & " first open interval:" & _
vbCrLf & _
Format$(DateBusySlot, "dddd, mmm d yyyy hh:mm AMPM")
Exit For
End If
End If
Next
End If
End Sub
Also you may try to get all meeting that starts or ends in a specific interval. The Find/FindNext or Restrict method can help with such tasks. Read more about them in the following articles:
How To: Use Restrict method in Outlook to get calendar items
How To: Retrieve Outlook calendar items using Find and FindNext methods
First time postings and I'm far from a VBA expert, but I've managed to stumble most of the way to my desired outcome thanks to boards like this one. I'm hoping to automate one last step and am looking for some assistance.
Background:
I run project reports for our Project Managers every Monday morning. The report template queries several tables in our database and populates all of the appropriate fields. It then creates a copy of itself, saves the formulas as values and saves the report using a naming mechanism capturing data from various fields in the report. All of this works great!
The Issue:
At any given time, I have 80-100 active projects. As it stands, I copy the list of projects to a table on the "Parameters" tab. Then, using data validation, I created a dropdown list on the "Report" tab. I then manually go 1 by 1 through the list to generate the report. Each time I change project number in cell B1, the data refreshes and runs the report for the project. I'm using this code to accomplish that:
Private Sub Worksheet_Change(ByVal Target As Range)
'MsgBox Target.Address
If Not Application.Intersect(Range("b1"), Range(Target.Address)) Is Nothing Then
Call AA_RunAll
End If
End Sub
What I'd like to do is create a macro that will run through each one of the projects on my list and run the report. I'm assuming it's a loop function, but I can't seem to get it to work as I want.
One other consideration to note: it takes 3-5 minutes per report to refresh all the data, generate the report and save it. I'd like to set this to run before I leave at night and have it done in the morning.
Thanks in advance.
Aaron
I think this may be what you are looking for.
Dim DataValidationRange As Range
Dim Str As String
Str = Replace(Range("B1").Validation.Formula1, "=", "")
Set DataValidationRange = Range(Str)
Dim i
For Each i In DataValidationRange
Range("B1").Value = i
Call AA_RunAll
Next
Also if you need to wait for the data to update before calling AA_RunAll, you could use this:
Public Function MyTimer(MyDelay As Double)
Dim MyTimerTimer As Double
MyTimerTimer = Timer
MyDelay = MyDelay + Timer
Do While MyTimerTimer <= MyDelay
MyTimerTimer = Timer
DoEvents
Loop
End Function
Private Sub GoThrough_Dropdown()
Dim DataValidationRange As Range
Dim Str As String
Str = Replace(Range("B1").Validation.Formula1, "=", "")
Set DataValidationRange = Range(Str)
Dim i
For Each i In DataValidationRange
Range("B1").Value = i
WaitForDataToUpdate
Call AA_RunAll
Next
End Sub
Private Sub WaitForDataToUpdate()
Dim RangeToWaitFor As Range
Set RangeToWaitFor = Range("H5")
Dim Str As String
Str = RangeToWaitFor.Value
Do While Str = RangeToWaitFor.Value
MyTimer 1
Loop
End Sub
I am using an Excel file with an Userform to control how long it takes for some people to complete a set of tasks.
I have an Userform that opens on start up and as soon as you click the button on it, the time starts counting. However, I don't really understand how I can do that.
I need the timer to run until the task is complete and the user clicks "Exit" or "Complete" and then save the time to my spreadsheet.
I propose slightly different approach. In the userform, declare variables:
Private startTime As Double
Private endTime As Double
Private blTime As Boolean
blTime is double that tells the application that the clock goes on. Then set value for startTime when userform is launched:
Private Sub UserForm_Initialize()
startime = Time
blTime = True
End Sub
I have assumed thet your button complete control is named cbComplete. Change to your button's real name
Private Sub cbComplete_Click()
If blTime Then endTime = Time
blTime = False
End Sub
The clock is turn off (blTime = False) when user click the button. You can add analogous code for other buttons as well but only the first click matters.
What we need is a way to get time that lapsed from the form. Use property:
Property Get Timespan() As Double
If Not blTime Then
Timespan = endTime - startTime
Else
Timespan = 0
End Property
Then, in module you can use command UserForm1.Timespan. Or format it nicely:
Format(UserForm1.Timespan, "hh:mm:dd")
Important: UserForm cannot be .Unload before, just .Hide.
You could adapt something like this:
Sub CalculateRunTime_Minutes()
'PURPOSE: Determine how many minutes it took for code to completely run
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim StartTime As Double
Dim MinutesElapsed As String
'Remember time when macro starts
StartTime = Timer
'*****************************
'Insert Your Code Here...
'*****************************
'Determine how many seconds code took to run
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
End Sub
To suit your needs. Source is here
You can learn more about VBA's Timer function here
A second option would be to use the Now function which will give you the current time. So for example:
t = Now
.... run your tasks....
tfinal = Now
time_elapsed = tfinal - t
I am currently working on a database for a small building with a large number of HDDs and the system I have made so far works exactly as my employer desires it to.
My current problem is with some VBA coding using macros to sign in and sign out each hard drive, the hard drives have a row each with a 'check in' and 'check out' button at the end. At current moment the coding works for both of these buttons but I have to write out the code for every single button both 'check in' and 'check out'.
Is there a way to convert the location of the button into a string which would then add itself into the coding and I can put in some sort of array that will auto locate the output of each button for me?
The macro is a simple .Show statement.
My excel sheet is illustrated below. Most of the current cells are programmed with formulas as this system needs to be fairly automated for the less skilled computer users.
Edit:
After clicking the button my initials are added to the end of current time/date. This needs to happen for many buttons all results being in different cells.
My recommendation would be to avoid using a button, and instead override the SelectionChanged event handler for the worksheet. Change the buttons to formatted cells, which when clicked will perform the action you desire.
First, configure your UserForm to return a value. One way to do this is by placing the following code into the code-behind for the UserForm:
Public Property Get Initials() As String
Initials = txtInitials.Text
End Property
Public Property Let Initials(ByVal sInitials As String)
txtInitials.Text = sInitials
End Property
Private Sub btnOk_Click()
Me.Hide
End Sub
Next, add the following code to Sheet1:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sInitials As String
Dim sDate As String
Dim sTime As String
Dim frmInitials As InitialsForm
If Target.Column = 13 Then
Set frmInitials = New InitialsForm
frmInitials.Show
sInitials = frmInitials.Initials
Unload frmInitials
sDate = Date
sTime = Time
Cells(Target.Row, 6).Value = sDate + " / " + sTime + " " + sInitials
End If
End Sub
When the user clicks on a cell in column 13 (M - "Check Out"), a userform will be displayed asking for the user's initials. Once they have entered them and pressed the OK button, the initials will be added to the end of the timestamp and inserted into column 6 (F) of the same row.
I am making my first Powerpoint 2007 macro and I am having a bit of trouble with it hanging, and not letting me move on to the next slide. I can press ESCAPE to quit the slideshow, but pressing space bar or anything else won't progress to the next slide. After a while, it just crashes. I come from a C++/Java background so I think its just something basic that I'm missing.
Basically I am trying to do a counter slide that counts the days/minutes/seconds from a particular date. When the slide loads I want it to show, in real time, how long its been since that date. I've put it through an infinite loop, which works fine to update the time, but then doesnt let me move on to the next slide.
Here's my code:
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
'If SSW.View.CurrentShowPosition = 3 Then
Do While SSW.View.CurrentShowPosition = 3 ' infinite loop
Dim currentSlide As Integer
currentSlide = SSW.View.CurrentShowPosition
Dim startDate As Date
Dim currentDate As Date
Dim sngDiff As Single
Dim lngDays As Long
Dim lngHours As Long
Dim lngMinutes As Long
Dim lngSeconds As Long
startDate = #7/22/2011 2:00:00 PM#
currentDate = Now
sngDiff = currentDate - startDate
lngDays = CLng(sngDiff)
sngDiff = sngDiff - lngDays
lngHours = Hour(sngDiff)
lngMinutes = Minute(sngDiff)
lngSeconds = Second(sngDiff)
With ActivePresentation.Slides(currentSlide)
With .Shapes(2)
.TextFrame.TextRange.Text = "It has been:" & lngDays & " Days " & lngHours & " hours " & lngMinutes & " minutes " & lngSeconds & " Seconds"
End With
End With
DoEvents
Loop
End Sub
Do I need to listen for some sort of button click to stop this infinite loop, or how do I do this?
Thanks.
A user form is something you add in the VBA editor; it's what you'd normally think of as a dialog box, though forms can be used for other things and needn't even become visible; that's what we're going to do here:
Option Explicit
Public bFormCodeRunning As Boolean
Sub FormDemo()
' Set a flag to let us know the code in the form
' is running
bFormCodeRunning = True
' "show" the form
UserForm1.Show vbModeless
End Sub
Sub KillForm()
' call this at some other point in the presentation
' when you're sure you're done running the form code
If Not bFormCodeRunning Then
Unload UserForm1
End If
' You could actually call this from your slide change event handler
End Sub
Then Insert, User Form from the menu to add a new form; doubleclick it to view its code and add this:
Private Sub UserForm_Activate()
' Don't show my face
Me.hide
DoEvents
' prove that the form's loaded
MsgBox "I'm well-formed"
DoEvents
' and put your other code here
' and when the code's done, flag it
bFormCodeRunning = False
End Sub
For doing a time delay in a VBA context it is usually better to use a form_timer object so in your code have:
If SSW.View.CurrentShowPosition = 3 Then
Me.TimerInterval = 1000
Else
Me.TimerInterval = 0
End If
Or something similar. Then in the form timer code have your clock update code
Private Sub Form_Timer()
// Your clock update code here
End Sub
It's been years since I've done any VBA so I'm a bit rusty but I hope this helps. In general use timers instead of loops for threading tasks, VBA doesn't cope well with them.
The problem is that your routine "owns" the app; until it exits, you won't be able to do anything manually (ie, advance to the next slide).
Whether or not you use a timer on a form (and fwiw, the Timer control isn't shipped with VBA as it is with VB), I think a form may be your solution.
Have your event handler load a form modelessly then exit.
The code in the form can then do any mods to slides or whatever else you want.
Include DoEvents often enough that you don't slow down the main app, but the code in the form will run independently of what the main app is doing.
You don't need to make the form visible (and probably don't want to).