New to VBA - Importing data based on a cell value

[xxchrisukxx]

Hi there,

I have an invoicing system setup with Excel.

I create a customer account in a spreadsheet, and save it as there account number. Say 1234.xls

I then close the customer account spreadsheet, and open an invoice. I enter their customer account number in, 1234.

I then need a way of importing data from the customer account file (1234.xls) without having to open the customer account file, or typing to formula =[1234.xls]Sheet1!$O$15.

Any ideas of a VBA script that will do the job?

[lucas]

Have you considered using just one workbook and a sheet for each account instead of a workbook?

[xxchrisukxx]

I have but we have over 500 accounts. Is there an easy way to arrange sheets in an order?

[lucas]

How are they named?

[lucas]

Try this on a copy of your workbook with a few sheets in it:
Option Explicit
Sub SortWorksheets()
' sort worksheets in a workbook in ascending order
Dim sCount As Integer, i As Integer, j As Integer
Application.ScreenUpdating = False
sCount = Worksheets.Count
If sCount = 1 Then Exit Sub
For i = 1 To sCount - 1
For j = i + 1 To sCount
If Worksheets(j).Name < Worksheets(i).Name Then
Worksheets(j).Move Before:=Worksheets(i)
End If
Next j
Next i
End Sub

[Charlize]

Maybe this could be usefull.Option Explicit
Sub Get_Address_Client()
Dim clientfile As String
If Range("A3").Value = vbNullString Then
MsgBox "No customernumber filled in !!!", vbInformation
Exit Sub
End If
clientfile = Dir("C:\Data\*.xls")
Do While clientfile <> ""
If Left(clientfile, Len(CStr(Range("A3").Value))) = _
CStr(Range("A3").Value) Then
CWRIR "C:\Data\", Range("A3").Value & ".xls", _
"Customer", "O15:O18", "B3"
MsgBox "Address details are copied !!!", vbInformation
Exit Sub
End If
clientfile = Dir
Loop
MsgBox "File for customer : " & Range("A3").Value & _
" has to be created first !!!", vbCritical
End Sub
Sub CWRIR(fPath As String, fName As String, sName As String, _
rng As String, destRngUpperLeftCell As String)
'CWRIR is short for ClosedWorkbookRangeIntoRange
Dim sRow As Integer
Dim sColumn As Integer
Dim sRows As Integer
Dim sColumns As Integer
Dim vrow As Integer
Dim vcol As Integer
Dim fpStr As String
Dim cArr()
Dim cwa
Dim destRange
On Error GoTo NoArr
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
If Dir(fPath & fName) = "" Then
cwa = CVErr(xlErrValue)
MsgBox "Error with file :" & vbCrLf & fName, vbCritical
Exit Sub
End If
sRow = Range(rng).Row
sColumn = Range(rng).Column
sRows = Range(rng).Rows.Count
sColumns = Range(rng).Columns.Count
ReDim cArr(sRows, sColumns)
Set destRange = ActiveSheet.Range(destRngUpperLeftCell)
For vrow = 1 To sRows
For vcol = 1 To sColumns
fpStr = "'" & fPath & "[" & fName & "]" & sName & "'!" & _
"r" & sRow + vrow - 1 & "c" & sColumn + vcol - 1
destRange.Offset(vrow - 1, vcol - 1) = ExecuteExcel4Macro(fpStr)
Next
Next
NoArr:
End Sub