Is my Code Too long??

[gringo287]

Hi,

Ive created a booking tracker that works fine at the moment, but, now that I'm trying to adjust the code to except more.. exceptions, its freezing for minutes at a time, when opening/triggering macro's.


The code below is in the sheet module.

Basically, the user books in an exception and when they click the "book exception" button, it emails details to the manager and also copies the details over the manager dashboard, which then sets the visibility of the corresponding "confirm" button, so that the manager can click the "confirm" button which signs off the exception and sends a confirmation to the relevant user.

The refresh macro is triggered when the email macro is triggered.

I currently have this set up to allow upto 16 exceptions (dont ask why I ended up with 16 and not 15), so the below code just loops through the 16. I now want to extend it to 50, so, my crude why of coding, is to just duplicate the code another 34 times. which is (I'm assuming) why its stated crashing/freezing.

I'm positive theres a much simpler and shorter way of achieving the same thing and will welcome any suggestions, but I'm more interested in whether it is just the extra lines thats causing the problem, as I wouldnt have thought that the mighty excel would struggle with this.


Sub refresh()
Application.ScreenUpdating = False
If Sheets("managerdash").Range("C4").Interior.Color = RGB(153, 153, 255) Then
Confirm1.Visible = True
Else:
Confirm1.Visible = False
End If


Private Sub confirm1_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C4").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub

[Paul_Hossler]

I currently have this set up to allow upto 16 exceptions (dont ask why I ended up with 16 and not 15), so the below code just loops through the 16


Where are the loops?

Paul

[gringo287]

Sub refresh()
Application.ScreenUpdating = False
If Sheets("managerdash").Range("C4").Interior.Color = RGB(153, 153, 255) Then
Confirm1.Visible = True
Else:
Confirm1.Visible = False
End If
If Sheets("managerdash").Range("C5").Interior.Color = RGB(153, 153, 255) Then
Confirm2.Visible = True
Else:
Confirm2.Visible = False
End If
If Sheets("managerdash").Range("C6").Interior.Color = RGB(153, 153, 255) Then
Confirm3.Visible = True
Else:
Confirm3.Visible = False
End If
If Sheets("managerdash").Range("C7").Interior.Color = RGB(153, 153, 255) Then
Confirm4.Visible = True
Else:
Confirm4.Visible = False
End If
If Sheets("managerdash").Range("C8").Interior.Color = RGB(153, 153, 255) Then
Confirm5.Visible = True
Else:
Confirm5.Visible = False
End If
If Sheets("managerdash").Range("C9").Interior.Color = RGB(153, 153, 255) Then
Confirm6.Visible = True
Else:
Confirm6.Visible = False
End If
If Sheets("managerdash").Range("C10").Interior.Color = RGB(153, 153, 255) Then
Confirm7.Visible = True
Else:
Confirm7.Visible = False
End If
If Sheets("managerdash").Range("C11").Interior.Color = RGB(153, 153, 255) Then
Confirm8.Visible = True
Else:
Confirm8.Visible = False
End If
If Sheets("managerdash").Range("C12").Interior.Color = RGB(153, 153, 255) Then
Confirm9.Visible = True
Else:
Confirm9.Visible = False
End If
If Sheets("managerdash").Range("C13").Interior.Color = RGB(153, 153, 255) Then
Confirm10.Visible = True
Else:
Confirm10.Visible = False
End If
If Sheets("managerdash").Range("C14").Interior.Color = RGB(153, 153, 255) Then
Confirm11.Visible = True
Else:
Confirm11.Visible = False
End If
If Sheets("managerdash").Range("C15").Interior.Color = RGB(153, 153, 255) Then
Confirm12.Visible = True
Else:
Confirm12.Visible = False
End If
If Sheets("managerdash").Range("C16").Interior.Color = RGB(153, 153, 255) Then
Confirm13.Visible = True
Else:
Confirm13.Visible = False
End If
If Sheets("managerdash").Range("C17").Interior.Color = RGB(153, 153, 255) Then
Confirm14.Visible = True
Else:
Confirm14.Visible = False
End If
If Sheets("managerdash").Range("C18").Interior.Color = RGB(153, 153, 255) Then
Confirm15.Visible = True
Else:
Confirm15.Visible = False
End If
If Sheets("managerdash").Range("C19").Interior.Color = RGB(153, 153, 255) Then
Confirm16.Visible = True
Else:
Confirm16.Visible = False
End If
End Sub



Private Sub confirm1_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C4").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm2_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C5").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm3_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C6").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm4_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C7").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm5_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C8").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm6_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C9").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm7_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C10").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm8_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C11").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm9_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C12").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm10_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C13").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm11_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C14").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm12_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C15").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm13_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C16").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm14_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C17").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm15_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C18").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub
Private Sub confirm16_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Sheets("managerdash").Range("C19").Interior.Color = RGB(0, 255, 0)
Call Mailto_Advisor_Click
End Sub

[SamT]

The BookException Button Runs the Email Macro, which set a particular Cell's color. This one assumes that the Cell contains all the particulars of that Tome.

the Refresh Sub Reads all the Cells to find which one is colored

The Confirm Button(s) reset that cells color, then Clicks the Mailto_Advisor Button

That is a very impossible method of passing information about several decades of books, let alone hundreds. Go back the the beginning and consider the following

Module Declarations:
Type Tome
Title As String
Author As String
ISBN As String
Recipient As String
End Type

Dim pBook As Tome

Property Get Book() As Tome
Book = pBook
End Property

Property Let Book(newBook As Tome)
pBook = NewBook
End Property

User Code:
Sub BookException_Click()
Dim myBook As Tome
With myBook 'Assumes that W,X,Y,& Z are input boxes
.Recipient = WWWW
.Author = XXXX
.Title = YYYY
.ISBN = ZZZZ
End With
Book = MyBook
Refresh
End Sub

Code:
Sub Refresh()
Dim Mybook As Tome
MyBook = Book
With Sheets("managerdash").Range("BookExeptions")
'Assumes a Range with Labels in Column1 and values go into Column 2
.Offset(1,1) = MyBook.Title
.Offset(2,1) = MyBook.author
.Offset(3,1) = MyBook.ISBN
.Offset(4,1) = MyBook.Recipient
End With
End Sub

Manager Code:
Private Sub confirmOnlyOne_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbNo Then
Exit Sub
End If
Mailto_Advisor_Click
End Sub

That's (almost) the entire code to handle many books

[snb]

?


Private Sub confirmOnlyOne_Click()
If MsgBox("Are you sure you want to Confirm the Exception?", vbYesNo, "Acknowledge") = vbYes Then Mailto_Advisor_Click
End Sub


Sub Refresh()
Sheets("managerdash").Range("BookExeptions").offset(1).resize(4)=application.transpose(array(book.title,book.author,bo ok.ISBN,book.Recipient))
End Sub

[Paul_Hossler]

No data to play with, so not really tested

I've seen this technique used to iterate through nicely named controls on worksheet.

If the controls are on a userform, it's a little different



Option Explicit
Sub refresh()
Dim iConfirm As Long

Application.ScreenUpdating = False

With Sheets("managerdash")
For iConfirm = 1 To 16
.OLEObjects("Confirm" & iConfirm).Visible = (.Cells(iConfirm + 1, 3).Interior.Color = RGB(153, 153, 255))
Next iConfirm
End With
End Sub



However, 50 controls are a lot. Maybe you could change your approach and use the WS double click or right click events

Paul

[gringo287]

sorry guys i should have just one this in the first place. I expected this to be a case of someone point out, my glaring mistake, I wasnt expecting as much response.

just add your own email address in the appropriate cells in userlist.10784