Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I tried to setup a UDF that would show detail information about an ID number.
I could click on the number and a comment would popup with the info. Worked really nice, until I tried to run another macro to add banding to the sheet. My first macro used the SelectionChange event to trigger it. My second macro changes the selection to do the banding, so now it triggers the first macro for each change in selection. It slowed it down to a crawl. Here are both UDFs. Does anybody have a suggestion on how to make them work together? Thanks - Mike The banding UDF: Sub Banding() Dim TempRow As String Dim varBackColor As Long Dim OnOff As Boolean vColor = ActiveCell.Interior.ColorIndex 'Get rid of any empty rows so the range selection will work 'Call DeleteEmptyRows 'To get rid of the annoying screen flicker and speed it up Application.ScreenUpdating = False 'Setup the selection and Get a count of the rows & columns Range("A1").Select Selection.CurrentRegion.Select cCol = Selection.Columns.Count cRows = Selection.Rows.Count TempRow = InputBox("Which row do you want to compare?") 'Can input either the column label,or the number of the column If Application.WorksheetFunction.IsNumber(TempRow) Then WhichColumn = TempRow ElseIf Application.WorksheetFunction.IsText(TempRow) Then WhichColumn = Asc(StrConv(TempRow, 1)) - 64 End If 'Walk through the list eRow = 2: sRow = 2 OnOff = True For i = 2 To cRows Range(Cells(i, WhichColumn), Cells(i, cCol)).Select If Cells(i, WhichColumn) < Cells(i + 1, WhichColumn) Then eRow = ActiveCell.Row Range(Cells(sRow, 1), Cells(eRow, cCol)).Select If OnOff Then With Selection.Interior .ColorIndex = vColor .Pattern = xlSolid ChooseBorders (15) End With OnOff = False Else With Selection.Interior .ColorIndex = xlNone End With OnOff = True End If sRow = eRow + 1 End If Next 'Turn Screen update back on Application.ScreenUpdating = True End Sub The comment box UDF: Private Sub Worksheet_SelectionChange(ByVal Target As Range) '* Subroutine to display a comment with the decoded information from '* the FICS barcode ID Tag. This only decodes ID Tags that start with '* J18CUSA. Other formats won't be decoded. This module should be loaded '* into the Selection_Change event of the worksheet. That way it will activate '* whenever you select a new cell. Dim fString As String, X As String Dim cmt As Comment 'Clear out the other comments so we don't get a clutter of comments Application.ScreenUpdating = False 'Turn off screen updates to speed it up For Each cmt In ActiveSheet.Comments cmt.Delete Next 'Add the comment If Target.Count = 1 Then 'Make sure only one cell is selected If Left(Target.Value, 7) = "J18CUSA" Then 'Make sure the cell has the FICS barcode info X = Target.Value vSerial = Mid(X, 8, 3) vDecSerial = CLng("&H" & vSerial) vPriority = Mid(X, 11, 1) vMonth = Mid(X, 12, 2) vDay = Mid(X, 14, 2) vHour = Mid(X, 16, 2) vMinute = Mid(X, 18, 2) vMSTDateTime = DateAdd("h", -7, DateSerial(Year(Now()), vMonth, vDay) + TimeSerial(vHour, vMinute, 0)) vDate = FormatDateTime(DateSerial(Year(Now()), vMonth, vDay), vbShortDate) vTime = FormatDateTime(TimeSerial(vHour, vMinute, 0), vbShortTime) vMSTDate = FormatDateTime(vMSTDateTime, vbShortDate) vMSTTime = FormatDateTime(vMSTDateTime, vbShortTime) Select Case vDecSerial Case 53: vLocal = 1 Case 72: vLocal = 2 Case 95: vLocal = 3 Case 114: vLocal = 4 Case 162: vLocal = 5 Case 2044: vLocal = 6 Case 2068: vLocal = 7 Case 2346: vLocal = 8 End Select fString = "Date/Time: " & vDate & " " & vTime & " GMT" & vbLf & _ "Date/Time: " & vMSTDate & " " & vMSTTime & " MST" & vbLf & _ "Machine: " & vDecSerial & " Local#: " & vLocal & vbLf & _ "Priority: " & vPriority Target.AddComment.Text Text:=fString With Target.Comment .Shape.TextFrame.AutoSize = True .Shape.Width = 250 .Shape.Height = 75 .Shape.TextFrame.Characters.Font.Size = 14 End With 'Format the labels with Bold Target.Comment.Shape.TextFrame.Characters(1, 10).Font.Bold = True Target.Comment.Shape.TextFrame.Characters(33, 10).Font.Bold = True Target.Comment.Shape.TextFrame.Characters(65, 8).Font.Bold = True Target.Comment.Shape.TextFrame.Characters(77, 8).Font.Bold = True Target.Comment.Shape.TextFrame.Characters(88, 9).Font.Bold = True End If End If Application.ScreenUpdating = True 'Turn it back on so we can see use the screen End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
MsgBox in Enter event causes combobox not to run Change event | Excel Programming | |||
How to trap delete row event and hide column event? | Excel Programming | |||
user form-on open event? keydown event? | Excel Programming | |||
Event Procedures: Event on Worksheet to fire Event on another Worksheet | Excel Programming | |||
OnTime event not firing in Workbook_Open event procedure | Excel Programming |