Help on writing code more efficiently (Loops)

[Kathryn]

Below is an example of code I wrote to copy data input in
one file (the active file) to other files. I only show
one file being updated, but I have other routines that
update additional files. Could someone show me how to
use variables & loops to condense the code and make it
more efficient e.g., method of defining and looping
through specific sheets in a workbook and performing a
series of actions (not all sheets in the workbooked
should be updated & some are updated in different
columns)?

Any input on this or any other type of suggestions would
be appreciated. Kathryn



//////////////////

Option Explicit

' Set string to ID path and name of support files
' (note: "AnotherFile" is not used in the example
' - I just put it in to show that the routine
' will be updating several other files).
Global path_Psn As String, file_Psn As String
Global file_AnotherFile As String

' Set string to ID main file; file provides data&date
Global Myfile As String

' Set string/date to ID amounts$ copied to other files
Global pr_item1 As String, pr_item2 As String
Global pr_item3 As String, pr_item4 As String
Global pd_item1 As String, pd_item2 As String
Global pd_item3 As String, pd_item4 As String
Global pr_item5 As String, pd_item5 As String
Global MyDate As Date

Sub MyRoutine()
Call GetVariableInfo
Call UpdateFile1
' Call UpdateFile2 ' Not used in example
End Sub

Sub GetVariableInfo()

' Define variables
path_Psn = "c:\Documents and Settings\"
file_Psn = "Position.xls"
file_AnotherFile = "My Second File.xls"
Myfile = ActiveWorkbook.name

' Defined by range names in worksheet
Windows(Myfile).Activate
pr_item1 = -Range("pr_item1").Value
pr_item2 = -Range("pr_item2").Value
pr_item3 = -Range("pr_item3").Value
pr_item4 = -Range("pr_item4").Value
pd_item1 = Range("pd_item1").Value
pd_item2 = Range("pd_item2").Value
pd_item3 = Range("pd_item3").Value
pd_item4 = Range("pd_item4").Value
pr_item5 = Range("pr_item5").Value
pd_item5 = -Range("pd_item5").Value
MyDate = Range("b2").Value
End Sub

Sub UpdateFile1()
Workbooks.Open Filename:=path_Psn & file_Psn, _
UpdateLinks:=False
Sheets(2).Select
Cells.Find(What:=MyDate, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(0, 2).Value = pd_item1
ActiveCell.Offset(0, 3).Value = pr_item1
Sheets(3).Select
Cells.Find(What:=MyDate, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(0, 2).Value = pd_item2
ActiveCell.Offset(0, 3).Value = pr_item2
Sheets(4).Select
Cells.Find(What:=MyDate, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(0, 2).Value = pd_item3
ActiveCell.Offset(0, 3).Value = pr_item3
Sheets(5).Select
Cells.Find(What:=MyDate, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(0, 2).Value = pd_item4
ActiveCell.Offset(0, 3).Value = pr_item4
Sheets(1).Select
Cells.Find(What:=MyDate, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(0, 7).Value = pr_item5
ActiveCell.Offset(0, 8).Value = pd_item5
End Sub

///////////////

 

[Bob Phillips]

Not much to offer without seeing it all, but you can make UpdateFile more
readable

Sub UpdateFile1()
Workbooks.Open Filename:=path_Psn & file_Psn, _
UpdateLinks:=False
FindAndUpdate Sheets(2), pd_item1, pr_item1, 2, 3
FindAndUpdate Sheets(3), pd_item2, pr_item2, 2, 3
FindAndUpdate Sheets(4), pd_item3, pr_item3, 2, 3
FindAndUpdate Sheets(5), pd_item4, pr_item4, 2, 3
FindAndUpdate Sheets(1), pr_item5, pd_item5, 7, 8
End Sub

Sub FindAndUpdate(sh As Worksheet, item1, item2, off1 As Long, off2 As Long)
Dim oCell As Range

With sh
Set oCell = .Cells.Find(What:=MyDate, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
oCell.Offset(0, off1).Value = item1
oCell.Offset(0, off2).Value = item2
End With

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Kathryn]

Bob - thx for your help. This is exactly what I was
looking for. Sorry for not getting back soon; caught a
cold & have been out a few days.

Thx, Kathryn

 

[Bob Phillips]

That's okay Kathryn. Thanks for letting me know, and I hope you are all
better now.
Regards

Bob