JoeMajestee
New Member
- Joined
- Jul 15, 2009
- Messages
- 49
I have a ton of code to paste, hopefully it won't be too cumbersome.
The first procedure below creates a dropdown menu on workbook open from which I can call procedureI. Second is my procedure that assigns procedureI to a keyboard shortcut. ProcedureI seems to work fine when called from the menu, but not when called by the keyboard. It opens the file containing invoices and then I'm not sure. I put a breakpoint at the workbook close line and the breakpoint never triggered. I've tried stepping through it from the keyboard shorcut and it worked. ProcedureI is posted third below, I left in the comments explaining what it does.
Any other suggestions would also be welcome and THANKS!!!
I also have a different procedure that assigns the same procedure to a keyboard shortcut SHIFT+CTRL+I
Finally, here is the procedure code.
The first procedure below creates a dropdown menu on workbook open from which I can call procedureI. Second is my procedure that assigns procedureI to a keyboard shortcut. ProcedureI seems to work fine when called from the menu, but not when called by the keyboard. It opens the file containing invoices and then I'm not sure. I put a breakpoint at the workbook close line and the breakpoint never triggered. I've tried stepping through it from the keyboard shorcut and it worked. ProcedureI is posted third below, I left in the comments explaining what it does.
Any other suggestions would also be welcome and THANKS!!!
Code:
Sub AddCAAmenus()
Dim CAAmenu01 As CommandBarControl
Dim cbMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim cbcCustomMenu As CommandBarControl
On Error GoTo 0
Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar")
iHelpMenu = cbMainMenuBar.Controls("Help").Index
Set cbcCustomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, _
Before:=iHelpMenu)
cbcCustomMenu.Caption = "&CAA"
cbcCustomMenu.Controls.Add(Type:=msoControlPopup).Caption = "&Worksheet Helpers"
With cbcCustomMenu.Controls("&Worksheet Helpers").Controls.Add(Type:=msoControlButton)
.Caption = "&Invoice Paid or Not"
.OnAction = "InvoicePaidOrNot"
End With
End Sub
I also have a different procedure that assigns the same procedure to a keyboard shortcut SHIFT+CTRL+I
Code:
Sub AssignMacrotoKeystroke()
Application.MacroOptions Macro:="caa.xls!InvoicePaidOrNot", Description:= _
"inserts a dropdown from which email addresses from allcontacts.csv can be selected" _
, ShortcutKey:="I"
End Sub
Finally, here is the procedure code.
Code:
Sub InvoicePaidOrNot()
'Assumes there is a column with "Invoice" in the top row
'makes blue all paid invoice numbers in "Invoice" column
'makes red all unpaid invoice numbers in column
'makes background yellow all invoice numbers in column that are not found
'assumes file exists
Dim sSrc As String
sSrc = "Invoice"
If CheckTopRowFor(sSrc) = 0 Then
MsgBox "This macro looks for a column with -Invoice- " & vbNewLine & _
"in the first row, labelling that column as containing " & vbNewLine & _
"invoice numbers. There is no such label in this worksheet" & vbNewLine & vbNewLine & _
"Exiting", vbCritical, "CAA Helperators"
Exit Sub
End If
NeedWorkbookOpen
StartCode
Dim iLookInXRows, iNumRowsInAllcontacts As Integer
Dim rSrc, rFindIn As Range, c, oFound As Object
iNumRowsInAllcontacts = Cells.SpecialCells(xlCellTypeLastCell).Row
Set rSrc = Range(Cells(2, CheckTopRowFor("Invoice")), Cells(iNumRowsInAllcontacts, CheckTopRowFor("Invoice")))
For Each c In rSrc
c.Value = Trim(c.Value)
Next c
sSrc = ActiveWindow.Caption
Workbooks.Open Filename:="F:\USERS\COMMON\CAA\DB Backup\qb-invoice-dump.csv"
iLookInXRows = Cells.SpecialCells(xlCellTypeLastCell).Row
Set rFindIn = Range(Cells(3, 1), Cells(iLookInXRows, 1))
For Each c In rSrc
With c ' reset to black font, no highlight, no comment
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlColorIndexAutomatic
.ClearComments
End With
If IsNumeric(c.Value) = False Or c.Value = "" Then GoTo nextC
Set oFound = rFindIn.Find(c.Value)
If oFound Is Nothing Then 'whatever is in invoice column was not found
With c
.Interior.ColorIndex = 6 'yellow
.AddComment
.Comment.Visible = False
.Comment.Text Text:="Invoice number" & Chr(10) & "not found"
End With
GoTo nextC
End If
If oFound.Offset(0, 4).Value = "" Then 'Looks in the Open Balance Column, "" indicates PAID
With c
.Font.ColorIndex = 5 'blue
End With
Else
With c
.Font.ColorIndex = 3 'red
.AddComment
.Comment.Visible = False
.Comment.Text Text:="Balance Due:" & Chr(10) & oFound.Offset(0, 4).Value
End With
End If
nextC:
Next c
Windows("qb-invoice-dump.csv").Close
EndCode
End Sub