Searching/Retrieving Data from another Workbook

[Jay]

Hello all,

I'm having some performance issues with something I'm working on, and I'm
hoping someone can point out some solutions. Maybe there's something I can
take advantage of that I didn't know about it.

I've got a list of product numbers. I'm trying to match the product number
(WB1) to a description that is contained in another workbook (WB2). WB1 and
WB2 can both contain thousands of rows.

This product number/description matching is being done in a macro that does
additional formatting. The macro runs fine until I get to this function.

My first attempt was to set the cell formula in WB1 to a vlookup to get the
value from WB2. This is PAINFULLY slow. I tried turning calculation to
manual, but it hasn't helped.

Then I thought I would search for the product number in WB2 myself. So I
have a function (in WB1) that opens WB2, and searches (in a do while loop)
through the appropriate column for a product number, and if found retrieves
the product description and places it in a cell in WB1. This is also
PAINFULLY slow.

I'm at a complete loss. I don't know any way to retrieve the value need
from WB2 without significant slowdown. I need to keep modifications to WB2
to a minimum, but if I can expect improved performance, I will push for
modifications. And I can't be sure that the list will be sorted or anything
like that.

If anyone has any insight into this issue, I would LOVE to hear it. I'll
take anything you've got.

Thanks,
Jay

 

[tigoda]

I use this one quite often, its handled thousands of values on both sheets
before, I have a feeling it can be improved by not activating the sheets to
look in them but its still pretty fast

Dim I, I2 As Integer
Dim S_Product, S_Desc As String


Sub Macro5()

I = 1

While Range("A" & I).Value <> ""
S_Product = Range("A" & I).Value
Windows("wb2.xls").Activate
I2 = 1
While Range("A" & I2).Value <> S_Product And Range("A" & I2).Value <> ""
I2 = I2 + 1
Wend
If Range("A" & I2).Value <> "" Then
S_Desc = Range("B" & I2).Value
Else
S_Desc = "not found"
End If
Windows("wb1.xls").Activate
Range("B" & I).Value = S_Desc
I = I + 1
Wend

End Sub

 

[cht13er]

I'm pretty surprised that it is painfully slow to go through even a
few thousand rows to find a value ... a few questions on that:
1) Are you matching a cell value from WB1 to each cell value in WB2
e.g. "IF sheets("WB1").cells(i,j).value = sheets("WB2").activecell
then"? This could slow you down a bunch ... better to assign your
value from WB1 to a constant and then it's "IF varValue =
sheets("WB2").activecell then"....
2) Are you stopping the search for the value in WB2 once you've found
something? (Or are you going through all thousands of rows blindly?)
3) Are you tabbing back and forth from WB1 and WB2 a lot? This DOES
slow you down - you should try to minimize the use of .select if you
can (there's no problem with assigning a value to a cell in WB1 if
it's not open!
4) While running the macro did you set "Application.ScreenUpdating =
False" and then back to true when you're done?

If this doesn't help, you could try to assign a filter to WB2 and then
copy the values over to WB1 ....


That's all I got - post here again if it works or if it doesn't

Chris

 

[tigoda]

I would defiantly agree with making sure you don’t have the word select or
selection anywhere. that can slow you down

If you do, just change

Blah.select
Selection.blah

To

blah.blah

I'm pretty surprised that it is painfully slow to go through even a
few thousand rows to find a value ... a few questions on that:
1) Are you matching a cell value from WB1 to each cell value in WB2
e.g. "IF sheets("WB1").cells(i,j).value = sheets("WB2").activecell
then"? This could slow you down a bunch ... better to assign your
value from WB1 to a constant and then it's "IF varValue =
sheets("WB2").activecell then"....
2) Are you stopping the search for the value in WB2 once you've found
something? (Or are you going through all thousands of rows blindly?)
3) Are you tabbing back and forth from WB1 and WB2 a lot? This DOES
slow you down - you should try to minimize the use of .select if you
can (there's no problem with assigning a value to a cell in WB1 if
it's not open!
4) While running the macro did you set "Application.ScreenUpdating =
False" and then back to true when you're done?

If this doesn't help, you could try to assign a filter to WB2 and then
copy the values over to WB1 ....


That's all I got - post here again if it works or if it doesn't

Chris

 

[Jay]

Good points. I'll post my code and then comment. If you have any questions
let me know.

Public Sub GetCommodityGroup()
On Error GoTo Err_GetCommodityGroup
Dim wrkbk As Workbook
Dim rowNum As Long ' row number
Dim cgRowNum As Long
Dim currentPart As String, currentCommodityGroup As String

Call SortFormattedByPart
Set wrkbk = Workbooks.Open(CG_WORKBOOK_PATH & CG_WORKBOOK_FILE, 0, True)

rowNum = 2

' loop through the rows of the formatted sheet
Do While ThisWorkbook.Worksheets(FE_SHEETNAME).Cells(rowNum,
FE_PART_COLNUM).Value <> ""

If currentPart <>
ThisWorkbook.Worksheets(FE_SHEETNAME).Cells(rowNum, FE_PART_COLNUM).Value Then
currentPart =
ThisWorkbook.Worksheets(FE_SHEETNAME).Cells(rowNum, FE_PART_COLNUM).Value
currentCommodityGroup = ""

' set status bar text to indicate process
Application.StatusBar = "Retrieving commodity group for part " &
currentPart & "..."

cgRowNum = 2
Do While wrkbk.Worksheets(CG_SHEETNAME).Cells(cgRowNum,
CG_ITEMNUMBER_COLNUM).Value <> ""
If currentPart =
TrimCINCOM(wrkbk.Worksheets(CG_SHEETNAME).Cells(cgRowNum,
CG_ITEMNUMBER_COLNUM).Value) Then
currentCommodityGroup =
Trim(wrkbk.Worksheets(CG_SHEETNAME).Cells(cgRowNum,
CG_COMMODITYGROUP_COLNUM).Value)
Exit Do
End If

cgRowNum = cgRowNum + 1
Loop

End If

ThisWorkbook.Worksheets(FE_SHEETNAME).Cells(rowNum,
FE_COMMODITYGROUP_COLNUM).Value = currentCommodityGroup

' increase row counter
rowNum = rowNum + 1
Loop

Exit_GetCommodityGroup:

' clear status bar text
Application.StatusBar = ""

wrkbk.Close False ' close workbook
Set wrkbk = Nothing ' free memory

Exit Sub

Err_GetCommodityGroup:
MsgBox Err.Number & Chr(10) & Err.Description
Resume Exit_GetCommodityGroup

End Sub

I sort the data in WB1 by part number, so I only need to retrieve the
description (commodity group) once and can reuse it until a new part number
is found.

Re: your comments...
1) Yeah, I assign the current part to a variable. I need to to run a
special trimming function to remove leading and trailing characters. These
characters are generated by the extraction program where this file
originates. Maybe I should also assign this value to a variable?

2) I stop the loop when I find the required product number in WB2.

3) No tabbing at all. At least not that I think so.

4) Yeah I set screen updating to false in the function that call this
function.

I have a feeling I'm missing something really obvious.

Thanks guys.
--
Disregard, this is so I can find my post later.
***postedbyJay***

I'm pretty surprised that it is painfully slow to go through even a
few thousand rows to find a value ... a few questions on that:
1) Are you matching a cell value from WB1 to each cell value in WB2
e.g. "IF sheets("WB1").cells(i,j).value = sheets("WB2").activecell
then"? This could slow you down a bunch ... better to assign your
value from WB1 to a constant and then it's "IF varValue =
sheets("WB2").activecell then"....
2) Are you stopping the search for the value in WB2 once you've found
something? (Or are you going through all thousands of rows blindly?)
3) Are you tabbing back and forth from WB1 and WB2 a lot? This DOES
slow you down - you should try to minimize the use of .select if you
can (there's no problem with assigning a value to a cell in WB1 if
it's not open!
4) While running the macro did you set "Application.ScreenUpdating =
False" and then back to true when you're done?

If this doesn't help, you could try to assign a filter to WB2 and then
copy the values over to WB1 ....


That's all I got - post here again if it works or if it doesn't

Chris

 

[Rob Edwards]

You can always use excels FIND function.

#
Selection.Find(What:=vSourcePart, After:=ActiveCell, LookIn:=xlFormulas
_
, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
#

vSourcePart is the item you are trying to find. Use error handling in
case nothing is found.

Rob Edwards

Always look on the bright side of life!

 

[Jay]

Rob, thanks for the tip. Gave me an idea and it seems to have solved my
problem. The entire formatting macro completes in under 2 minutes. The
improvements are significant as it using my previous solutions I never
actually completed processing.

Here's the solution (code). I can probably find a few improvements, but
it's operational in it's current state.

Public Sub GetCommodityGroup()
On Error GoTo Err_GetCommodityGroup
Dim wrkbk As Workbook
Dim rowNum As Long ' row number
Dim currentPart As String, currentCommodityGroup As String

Call SortFormattedByPart

' set status bar text to indicate process
Application.StatusBar = "Opening commodity group file " &
CG_WORKBOOK_FILE & "..."
Set wrkbk = Workbooks.Open(CG_WORKBOOK_PATH & CG_WORKBOOK_FILE, 0, True)

rowNum = 2

' loop through the rows of the formatted sheet
Do While ThisWorkbook.Worksheets(FE_SHEETNAME).Cells(rowNum,
FE_PART_COLNUM).Value <> ""

' if this is a new part number
If currentPart <>
ThisWorkbook.Worksheets(FE_SHEETNAME).Cells(rowNum, FE_PART_COLNUM).Value Then
currentPart =
ThisWorkbook.Worksheets(FE_SHEETNAME).Cells(rowNum, FE_PART_COLNUM).Value
currentCommodityGroup = ""

' set status bar text to indicate process
Application.StatusBar = "Retrieving commodity group for part " &
currentPart & "..."

With wrkbk.Worksheets(CG_SHEETNAME).Cells
Set c = .Find(currentPart, LookIn:=xlValues)
If Not c Is Nothing Then
Do
If TrimCINCOM(c.Value) = currentPart Then
currentCommodityGroup =
Trim(wrkbk.Worksheets(CG_SHEETNAME).Cells(c.Row,
CG_COMMODITYGROUP_COLNUM).Value)
Exit Do
End If

Set c = .FindNext(c)
Loop While Not c Is Nothing
End If
End With

End If

ThisWorkbook.Worksheets(FE_SHEETNAME).Cells(rowNum,
FE_COMMODITYGROUP_COLNUM).Value = currentCommodityGroup

' increase row counter
rowNum = rowNum + 1
Loop

Exit_GetCommodityGroup:

' clear status bar text
Application.StatusBar = ""

wrkbk.Close False ' close workbook
Set wrkbk = Nothing ' free memory

Exit Sub

Err_GetCommodityGroup:
MsgBox Err.Number & Chr(10) & Err.Description
Resume Exit_GetCommodityGroup

End Sub

 

[cht13er]

Showing the status bar and updating it all the time must be taking up
some time ... try commenting out that bit and see if there's a
difference?

Can you even read the status bar? It must whiz by pretty fast, no? If
you do decide to get rid of it, use Application.ScreenUpdating = False
at the start of your code and =True at the completion .....

Chris