Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 89
Default Help with event

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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
MsgBox in Enter event causes combobox not to run Change event Richard Excel Programming 0 March 6th 06 02:52 PM
How to trap delete row event and hide column event? Alan Excel Programming 3 April 26th 05 04:25 PM
user form-on open event? keydown event? FSt1[_3_] Excel Programming 2 August 5th 04 02:26 PM
Event Procedures: Event on Worksheet to fire Event on another Worksheet Kathryn Excel Programming 2 April 7th 04 07:35 PM
OnTime event not firing in Workbook_Open event procedure GingerTommy Excel Programming 0 September 24th 03 03:18 PM


All times are GMT +1. The time now is 03:45 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"