Lookup function in code

D

dean.brunne

Hi,
The code below is to create a workbook for each of the sheets in the
array and then save each workbook and save into its specific directory
which is stored in a range. I attempted to use the Lookup function
but it is giving me a type mismatch error. Please advise. Cheers-
Dean

Range named "dir"

Group Directory
ops "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\ops.xls"
sales "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\sales.xls"
mark "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\mark.xls"
lnl "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\lnl.xls"
fwp "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\fwp.xls"
pbc "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\pbc.xls"
rtd "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\rtd.xls"
wine "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\wine.xls"

CODE

Sub CreateWorkbooks()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim FilePath As String
Dim MyArray As Variant
Dim rng As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

Set WbMain = ThisWorkbook

MyArray = Array("ops", "sales", "mark", "lnl", "fwp", "pbc",
"rtd", "wine")
Set rng = Range("dir")

For Each sh In WbMain.Worksheets(MyArray)
If sh.Visible = -1 Then
sh.Copy
Set Wb = ActiveWorkbook
FilePath = Application.WorksheetFunction.Lookup(MyArray,
rng)
Wb.SaveAs FilePath
Wb.Close False
End If
Next sh


Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
 
G

Guest

Dean,

Give this a try.


Sub CreateWorkbooks()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim FilePath As String
Dim MyArray As Variant
Dim rng As Range
Dim i As Integer

Application.ScreenUpdating = False
Application.EnableEvents = False

Set WbMain = ThisWorkbook

MyArray = Array("ops", "sales", "mark", "lnl", "fwp", "pbc", "rtd",
"wine")
Set rng = Range("dir")

For i = 0 To UBound(MyArray)
Set sh = WbMain.Worksheets(MyArray(i))
If sh.Visible = -1 Then
sh.Copy
Set Wb = ActiveWorkbook
FilePath = Application.WorksheetFunction.VLookup(MyArray(i),
rng, 2, False)
Wb.SaveAs FilePath
Wb.Close False
End If
Next i

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top