Thanks for the suggestion, but that didn't make any difference :(
Here's the code that I'm running (I removed some extraneous stuff, bu
sorry, it's still long):
Code
-------------------
Sub UpdateFundList()
Dim fromWkBk As Excel.Workbook, toWkBk As Excel.Workbook
Dim Fi, Msg, Targ As String
On Error GoTo ErrMsg
ThisWorkbook.Activate
Set fromWkBk = OpenWkBk(Range("PriorPath"), Range("PriorWorkbook"))
ThisWorkbook.Activate
Set toWkBk = OpenWkBk(Range("CurrentPath"), Range("CurrentWorkbook"))
fromWkBk.Activate
On Error GoTo 0
On Error Resume Next
' Update Current Fundlist From Client's Prior Year Fundlist (Adds funds special to this client)
SetupFunds fromWkBk, toWkBk, "FundList" ; FundList is a named range containing a list of fund names
' Close Prior Year Workbook and Activate Current Year Workbook
fromWkBk.Activate
ActiveWorkbook.Close (False)
ThisWorkbook.Activate
Exit Sub
ErrMsg:
If Err.Number < 0 Then
Msg = "Error # " & str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description & Chr(13) & "Procedure No: 3 (UpdateFundList)"
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
Stop
End If
Resume Next
End Sub
Sub SetupFunds(fromWkBk As Excel.Workbook, toWkBk As Excel.Workbook, FdList As String)
' Copies "FundList" Funds into Current Year's Budget from Prior Year's Budget if they are missing in Current Year's "FundList"
Dim CurrFund, fromRow, toRow, Target, Found, c, fromList, toList, activeFund, fromWs, toWs
Dim CurrRow, GetsLAVTR, Msg, ClntFdNo As String
On Error GoTo ErrMsg
Found = False
' Put "FundList" object names into variables
Set fromWs = fromWkBk.Worksheets("Data")
Set toWs = toWkBk.Worksheets("Data")
Set fromList = fromWs.Range(FdList)
Set toList = toWs.Range(FdList)
fromRow = 1
' Step thru Prior Workbook.Data "FundList"
For Each CurrFund In fromList
Target = CurrFund
activeFund = fromList.Cells(fromRow).Offset(0, 1)
' If Fund is Active Locate Prior "FundList" Fund in Current "FundList"
If UCase(activeFund) = "Y" Then
toWs.Activate
With toList
.Select
Set c = .Find(Target, LookIn:=xlValues)
If Not c Is Nothing Then
' Found It
If c.Value = Target Then
Found = True
toRow = c.Row - toList.Row + 1
End If
End If
End With
If Not Found Then
toRow = InsertDataRow(fromWs, toWs, fromList, toList, FdList, fromRow, toRow + toList.Row - 1)
End If
End If
Found = False
fromRow = fromRow + 1
Next CurrFund
Exit Sub
ErrMsg:
If Err.Number < 0 Then
Msg = "Error # " & str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description & Chr(13) & "Procedure No: 4 (SetupFunds)"
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
Stop
End If
Resume Next
End Sub
Function InsertDataRow(fromWs, toWs, fromList, toList, FdList As String, ByVal fromRow As Integer, ByVal toRow As Integer) As Integer
Dim Target, Found As Boolean, c, GeneralRow, Msg
' Fund was NOT found in FundList, Find insertion point
On Error GoTo ErrMsg
Found = False
Do
' Get Target from fromList
fromWs.Activate
With fromList
.Select
fromRow = fromRow - 1
Target = fromList.Cells(fromRow)
End With
' Try to find Target in toList
toWs.Activate
With toList
.Select
Set c = .Find(Target, LookAt:=xlWhole, LookIn:=xlValues)
If Not c Is Nothing Then
' Found previousTarget
Found = True
toRow = c.Row
c.Select
End If
End With
Loop Until Found = True
' Insert a blank row for data from Prior Workbook.Data "FundList" to be put into
Selection.Offset(1, 0).EntireRow.Insert
Selection.Offset(1, 0).Select
toRow = Selection.Row
InsertDataRow = toRow - toList.Row + 1
Exit Function
ErrMsg:
If Err.Number < 0 Then
Msg = "Error # " & str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description & Chr(13) & "Procedure No: 6 (InsertDataRow}"
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
Stop
End If
Resume Next
End Function
--------------------
---
Message posted from
http://www.ExcelForum.com/