Retrieving Excel Database Data

[Brian C]

Hi,

I (with the patient help of Ron De Bruin) created a VBA routine that takes
data from one worksheet, and puts it into another "Database" worksheet,
identifying whether there are duplicate entries and notifying the user if
there are. Here's the link to my previous post:
http://www.microsoft.com/office/com...&p=1&tid=715f1da9-d0b4-4e18-b7b0-2b00a8a8741c

Here's the question. Now I'd like to allow the user to find the right data,
using a text string, and load it back to the original spreadsheet, and prompt
them with a message of "Customer Not Found" if it doesn't exist. I'd like
them to be able to search with partial strings, show all matching results,
and allow them to select the correct one.

I realize this is a big request, but I'd appreciate any help.

Thanks,

Brian

 

[Tom Ogilvy]

Look at the Autofilter under the Data menu item.

If you need code, turn on the macro recorder while you perform the action
manually, then modify the code.

Ron also has sample code for analyzing data using an Autofilter.

http://www.rondebruin.nl/copy5.htm


If you are going to utilize Macros, you really need to invest some sweat
equity in learning how understand and modify them as they will certainly
become problematic at some point in the future.

 

[Brian C]

Hi Tom,

I wasn't clear. The data resides in another Workbook, not another
spreadsheet. I want the user to be able to enter some text in a field in the
first workbook, and then use that text to search for data in the second
sheet, without the user having to mess around with drop down arrows.

I've written some code to try to do this, but can't get it to find the data
and copy it. If you wouldn't mind taking a look at my code and providing
some pointers, I'd be grateful.

Thanks,

Brian

Here's the code:

Sub Retrieve_Customer_Data()

Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim sourceWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer
Set destWB = ThisWorkbook
Set sourceRange = destWB.Worksheets("Customer Data").Range("b6")
Set destrange = destWB.Worksheets("Sheet3").Range("A7:ch7")
Application.ScreenUpdating = False
If bIsBookOpen("CustomerData.xls") Then
Set sourceWB = Workbooks("CustomerData.xls")
Else
Set sourceWB = Workbooks.Open("c:\CustomerData.xls")
End If

sourceWB.Activate
Worksheets("Sheet1").Activate
With sourceWB.Sheets("Sheet1").Range("D")
Set rng = .Find(What:=sourceRange.Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rng Is Nothing Then
rng.Copy
Else

answer = MsgBox("Loading Customer Information")
destWB.Sheets("Sheet1").Visible.true
destWB.Sheets("Sheet1").destrange.PasteSpecial
xlPasteValues, , False, False
Application.CutCopyMode = False
sourceWB.Close True

End If
End With
End Sub

 

[Tom Ogilvy]

Sub Retrieve_Customer_Data()

Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim sourceWB As Workbook
Dim rng As Range

Set destWB = ThisWorkbook
Set sourceRange = destWB.Worksheets("Customer Data").Range("b6")
Set destrange = destWB.Worksheets("Sheet3").Range("A7")

If bIsBookOpen("CustomerData.xls") Then
Set sourceWB = Workbooks("CustomerData.xls")
Else
Set sourceWB = Workbooks.Open("c:\CustomerData.xls")
End If


With sourceWB.Sheets("Sheet1").Range("D")
Set rng = .Find(What:=sourceRange.Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With

If Not rng Is Nothing Then
rng.Copy destrange
Else
MsgBox SourceRange.Value & " not found"
End If
End Sub

Hard to tell what you were doing at the bottom, but none of it made sense.

 

[Brian C]

Hi Tom,

For some reason, the code isn't looking up the correct data. It seems to
always select cell F7, and only copies that cell.

I also wanted to select the entire row of the cell that is identified in the
search function, and copy that to the other workbook.

Please take a look at the code and let me know if you see where I'm making
my mistake.

Thanks,

Brian

Sub Retrieve_Customer_Data()

Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim sourceWB As Workbook
Dim rng As Range
Dim IDrow As Range
Set destWB = ThisWorkbook
Set sourceRange = destWB.Sheets("Customer Data").Range("b6")
Set destrange = destWB.Worksheets("Sheet3").Range("A7")

If bIsBookOpen("CustomerData.xls") Then
Set sourceWB = Workbooks("CustomerData.xls")
Else
Set sourceWB = Workbooks.Open("c:\CustomerData.xls")
End If

With sourceWB.Sheets(1).Range("D")
Set rng = .Find(What:=sourceRange.Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

Set IDrow = ActiveCell.EntireRow
End With

If Not rng Is Nothing Then
IDrow.Copy destrange

Else
MsgBox sourceRange.Value & " not found"
End If
sourceWB.Close
End Sub

 

[Tom Ogilvy]

I guess that is because you are copying the row of the activecell (which
must be F7 and never changes in your code) rather than the row of the found
cell. Assuming you want the row of the found cell to be copied:

Sub Retrieve_Customer_Data()

Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim sourceWB As Workbook
Dim rng As Range
Dim IDrow As Range
Set destWB = ThisWorkbook
Set sourceRange = destWB.Sheets("Customer Data").Range("b6")
Set destrange = destWB.Worksheets("Sheet3").Range("A7")

If bIsBookOpen("CustomerData.xls") Then
Set sourceWB = Workbooks("CustomerData.xls")
Else
Set sourceWB = Workbooks.Open("c:\CustomerData.xls")
End If

With sourceWB.Sheets(1).Range("D")
Set rng = .Find(What:=sourceRange.Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

End With

If Not rng Is Nothing Then
rng.Entirerow.Copy destrange

Else
MsgBox sourceRange.Value & " not found"
End If
sourceWB.Close
End Sub