A
ADraughn
Greetings all.
Windows xp
xl97
This code is way too slow. Any help would be appreciated.
-I have a user form that creates an invoice. When they enter the
product number into the form, if it is not found in the list,another
form appears.
-This form allows them to enter the product description and code.
-There is a button on the sub form that allows the user to search the
current parts list for similar descriptions to get the appropriate code
to use.
The code attached is located on the third form. They enter the
description to search for and hit the cmdSearch button. It works but is
too slow.
Thanks in advance,
-doodle
Private Sub cmdSearch_Click()
On Error GoTo errClear
Dim mysrc As Integer '# used in status bar so i can see progress
Dim i As String
mysrc = 6
i = frmPartsList.txtSearchCriteria.Text
Application.ScreenUpdating = False
Application.StatusBar = "Searching Row # " & mysrc
'Clears previous temp table
Range("GO6:GQ65536").ClearContents
Select Case cmbSearchBy
Case Is = "Product Description" 'If searching by desription
Sheets("Data").Select
With Worksheets("Data").Range("gm6:gm65536") 'with descrip
column
Set c = .Find(What:=i, LookIn:=xlValues,
lookat:=xlPart) 'find search text
If Not c Is Nothing Then
firstAddress = c.Address
Do 'Keep looking until found all
mysrc = mysrc + 1 'Update my status bar
Application.StatusBar = "Searching Row # " & mysrc
' Update my temp table with results
Set myRow =
Sheets("Data").Range("GO65536").End(xlUp)
myRow.Offset(1, 0).Value =
Range(c.Address).Offset(0, -2).Text
myRow.Offset(1, 1).Value =
Range(c.Address).Offset(0, -1).Text
myRow.Offset(1, 2).Value =
Range(c.Address).Text
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <>
firstAddress
End If
End With
Case "Part Number" 'same as code above except looking at number
column
Sheets("Data").Select
With Worksheets("Data").Range("gk6:gk65536")
Set c = .Find(What:=i, LookIn:=xlValues,
lookat:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
mysrc = mysrc + 1
Application.StatusBar = "Searching Row # " & mysrc
Set myRow =
Sheets("Data").Range("GO65536").End(xlUp)
myRow.Offset(1, 2).Value =
Range(c.Address).Offset(0, 2).Text
myRow.Offset(1, 1).Value =
Range(c.Address).Offset(0, 1).Text
myRow.Offset(1, 0).Value =
Range(c.Address).Text
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <>
firstAddress
End If
End With
End Select
If c Is Nothing Then MsgBox Prompt:="There are no parts listed" & _
" that match your search.", Buttons:=vbOKOnly
If Not c Is Nothing Then frmPartsList.lstParts.Visible = True
If Not c Is Nothing Then frmPartsList.lblPartNum.Visible = True
If Not c Is Nothing Then frmPartsList.lblPartNum2.Visible = True
If Not c Is Nothing Then frmPartsList.lblHCode.Visible = True
If Not c Is Nothing Then frmPartsList.lblHCode2.Visible = True
If Not c Is Nothing Then frmPartsList.lblPart.Visible = True
Sheets("FrontPage").Select
Application.ScreenUpdating = True
Application.StatusBar = False
Exit Sub
errClear:
Sheets("FrontPage").Select
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
Windows xp
xl97
This code is way too slow. Any help would be appreciated.
-I have a user form that creates an invoice. When they enter the
product number into the form, if it is not found in the list,another
form appears.
-This form allows them to enter the product description and code.
-There is a button on the sub form that allows the user to search the
current parts list for similar descriptions to get the appropriate code
to use.
The code attached is located on the third form. They enter the
description to search for and hit the cmdSearch button. It works but is
too slow.
Thanks in advance,
-doodle
Private Sub cmdSearch_Click()
On Error GoTo errClear
Dim mysrc As Integer '# used in status bar so i can see progress
Dim i As String
mysrc = 6
i = frmPartsList.txtSearchCriteria.Text
Application.ScreenUpdating = False
Application.StatusBar = "Searching Row # " & mysrc
'Clears previous temp table
Range("GO6:GQ65536").ClearContents
Select Case cmbSearchBy
Case Is = "Product Description" 'If searching by desription
Sheets("Data").Select
With Worksheets("Data").Range("gm6:gm65536") 'with descrip
column
Set c = .Find(What:=i, LookIn:=xlValues,
lookat:=xlPart) 'find search text
If Not c Is Nothing Then
firstAddress = c.Address
Do 'Keep looking until found all
mysrc = mysrc + 1 'Update my status bar
Application.StatusBar = "Searching Row # " & mysrc
' Update my temp table with results
Set myRow =
Sheets("Data").Range("GO65536").End(xlUp)
myRow.Offset(1, 0).Value =
Range(c.Address).Offset(0, -2).Text
myRow.Offset(1, 1).Value =
Range(c.Address).Offset(0, -1).Text
myRow.Offset(1, 2).Value =
Range(c.Address).Text
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <>
firstAddress
End If
End With
Case "Part Number" 'same as code above except looking at number
column
Sheets("Data").Select
With Worksheets("Data").Range("gk6:gk65536")
Set c = .Find(What:=i, LookIn:=xlValues,
lookat:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
mysrc = mysrc + 1
Application.StatusBar = "Searching Row # " & mysrc
Set myRow =
Sheets("Data").Range("GO65536").End(xlUp)
myRow.Offset(1, 2).Value =
Range(c.Address).Offset(0, 2).Text
myRow.Offset(1, 1).Value =
Range(c.Address).Offset(0, 1).Text
myRow.Offset(1, 0).Value =
Range(c.Address).Text
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <>
firstAddress
End If
End With
End Select
If c Is Nothing Then MsgBox Prompt:="There are no parts listed" & _
" that match your search.", Buttons:=vbOKOnly
If Not c Is Nothing Then frmPartsList.lstParts.Visible = True
If Not c Is Nothing Then frmPartsList.lblPartNum.Visible = True
If Not c Is Nothing Then frmPartsList.lblPartNum2.Visible = True
If Not c Is Nothing Then frmPartsList.lblHCode.Visible = True
If Not c Is Nothing Then frmPartsList.lblHCode2.Visible = True
If Not c Is Nothing Then frmPartsList.lblPart.Visible = True
Sheets("FrontPage").Select
Application.ScreenUpdating = True
Application.StatusBar = False
Exit Sub
errClear:
Sheets("FrontPage").Select
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub