Running a Macro continuously

[Arcadian]

Hello everyone,

I have a question.

I want to create a simple macro which continuously checks the data in cell A1.
Right now it doesn't work. I have to select "Run Macro" in the menu everytime I want my macro to check the data.
I know it's possible to automate this process and I suspect/hope it's very simple.

The code I'm using is as follows:

Sub test()
If [A1] = 1 Then
[B1] = "1"
ElseIf [A1] = 2 Then
[B1] = "2"
ElseIf [A1] = 3 Then
[B1] = "3"
ElseIf [A1] = 4 Then
[B1] = "4"
ElseIf [A1] > 4 Then
[B1] = "Wrong Entry"
ElseIf [A1] < 0 Then
[B1] = "Wrong Entry"
End If
End Sub

My experience with Visual Basic is no greater then the above lines of code so I'd apreciate it if you could keep it simple

Tim

Edit: I forgot to tell you, cell A1 is a pulldown list, created with the validation>list option.

 

[shg]

I can't tell what you're trying to do. Maybe this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rInt        As Range
    Dim cell        As Range

    Set rInt = Intersect(Target, Range("N46:N51, N56:N59"))
    
    If Not rInt Is Nothing Then
        On Error GoTo Oops
        Application.EnableEvents = False
        
        For Each cell In rInt
            If VarType(cell.Value2) = vbDouble Then
                cell.Value2 = Application.MRound(cell.Value2, 6)
            End If
        Next cell
    End If

Outtahere:
    Application.EnableEvents = True
    Exit Sub

Oops:
    MsgBox "Oops! Error " & Error.Number
    Resume Outtahere
End Sub

 

[BJungheim]

Hello, all! I have a very similar situation except I can't get the second part to work. I have an order form with certain items that need to be ordered in quantities of six. The "Worksheet_Activate()" bit works; if I click into 'Sheet 2' and back into 'Sheet 1', the macro auto-runs and rounds the quantities in the select cells to multiples of 6.

Here's my code:

Private Sub Worksheet_Activate() 'This part is working fine
For Each cell In [N46:N51, N56:N59]
If cell = " " Then Exit Sub
cell.Value = Application.MRound(cell.Value, 6)
Next cell
End Sub


Private Sub Worksheet_Change(ByVal Target As Range) 'This part isn't working
For Each cell In [N46:N51, N56:N59]
If cell = " " Then Exit Sub
cell.Value = Application.MRound(cell.Value, 6)
Next cell
End Sub

The error I receive is "Run-time error '28': Out of stack space"; when I click to debug, "For Each cell In [N46:N51, N56:N59]" (under 'Worksheet_Change...") is highlighted.

Any ideas?

Thanks!

On the worksheet_change event you need to disable events so you don't get stuck in an endless loop (each time the code runs it triggers itself):

Private Sub Worksheet_Change(ByVal Target As Range) 'This part isn't working
Application.EnableEvents = False
For Each cell In [N46:N51, N56:N59]
If cell = " " Then Exit Sub
cell.Value = Application.MRound(cell.Value, 6)
Next cell
Application.EnableEvents = True
End Sub

 

[treepanic]

Awesome, BJungheim! For the record, this is my final, working script:

Private Sub Worksheet_Activate() 'This part is working fine
For Each cell In [N46:N51, N56:N59]
If cell = " " Then Exit Sub
cell.Value = Application.MRound(cell.Value, 6)
Next cell
End Sub


Private Sub Worksheet_Change(ByVal Target As Range) 'This part isn't working
Application.EnableEvents = False
For Each cell In [N46:N51, N56:N59]
If cell = " " Then Exit Sub
cell.Value = Application.MRound(cell.Value, 6)
Next cell
Application.EnableEvents = True
End Sub

Thanks for all your help!

 

[BJungheim]

Awesome, BJungheim! For the record, this is my final, working script:

Private Sub Worksheet_Activate() 'This part is working fine
For Each cell In [N46:N51, N56:N59]
If cell = " " Then Exit Sub
cell.Value = Application.MRound(cell.Value, 6)
Next cell
End Sub


Private Sub Worksheet_Change(ByVal Target As Range) 'This part isn't working
Application.EnableEvents = False
For Each cell In [N46:N51, N56:N59]
If cell = " " Then Exit Sub
cell.Value = Application.MRound(cell.Value, 6)
Next cell
Application.EnableEvents = True
End Sub

Thanks for all your help!

In hindsight you may want to add the enableevents toggles to the worksheet activate process as well...it won't hurt anything not to add it but you'll be running the same code twice when you activate the sheet. There's not really any reason to do so.

 

[jessebw2005]

I have multiple macros I need to run using this code ( private Sub Worksheet_Activate() and Private Sub Worksheet_Change(ByVal Target as Range) so that each change runs all macros again. I know I can use runallmacros but don't know how to write in with this code or if there is away to apply this code to multiple macros. Greatly appreciate the help.

 

[jin_yeugh]

Sorry if I missed the answer to my question but I'm just getting started with VBA and I'm trying to solve a similar problem. I would like to change the font of multiple cells based on the value one column of cells. I want this to constantly run in the background but the solution from onlyadrafter didn't work for me.

The code, which works when I manually run it, is:

Sub changeTextColor()
 
    GreenColor = RGB(0, 255, 0)
    RedColor = RGB(255, 0, 0)
    BlackColor = RGB(0, 0, 0)
    
    'Get number of rows in the specified column
    RowsCount = Range("C2", Range("C2").End(xlDown)).Rows.Count
    
    'Select cell
    Range("C2").Select
    
    'Loop the cells
    For x = 1 To RowsCount
        If ActiveCell.Value = "approved" Then
            'Change the text color
            ActiveCell.Font.Color = GreenColor
        ElseIf ActiveCell.Value = "rejected" Then
            'Change the text color
            ActiveCell.Font.Color = RedColor
        Else
            ActiveCell.Font.Color = BlackColor
        End If
    
        ActiveCell.Offset(1, 0).Select
    Next
    
End Sub

 

[a2sovolunteers]

I am looking for a way to constantly run my VBA. I am using Excel to automatically email volunteers on their birthdays. Currently, I have to open the sheet and run in manually every day in order to have it work. (I am not using it yet still testing) Is there a way to have it always go? Would Excel/Outlook always need to be open to achieve this?

I'm also looking for a way to make the e-mail that is sent have some HTML content, an image, and colored text, etc. Any suggestions on this? This is the code I'm currently using that only allows me basic text.

Sub DoBirthdayRoutine()


Dim olApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Msg As String
Set olApp = New Outlook.Application
Application.ScreenUpdating = False
Sheets("Sheet1").Activate
LR = Range("B" & Rows.Count).End(xlUp).Row
For Each cell In Range("B2:B" & LR)
If Month(cell) = Month(Date) And Day(cell) = Day(Date) Then
Pos = WorksheetFunction.Find(" ", cell.Offset(, -1))
FName = Left(cell.Offset(, -1), Pos - 1)
Subj = "Happy Birthday!"
EmailAddr = cell.Offset(, 1).Value
Msg = "Dear " & FName & "," & vbNewLine
Msg = Msg & vbNewLine & " Happy Birthday. We hope your day is filled with joy!" & vbCrLf & vbCrLf


Set MItem = olApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr
.Subject = Subj
.Body = Msg
.Send
End With
End If
Next


Application.ScreenUpdating = True


End Sub

 

[Ruddles]

Use Windows Task Scheduler to open your workbook at once a day and use Workbook_Open to check whether anyone is due an email today. After you send an email, add a year to the date so it won't be run again until next year.