View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
OldRod[_3_] OldRod[_3_] is offline
external usenet poster
 
Posts: 1
Default Problem with a macro

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/