Selected Answer
I have re-written your code. Paste the procedures below to a standard code module of a macro-enabled workbook and run the sub routine Recalc.
Option Explicit
Sub Recalc()
' 27 Jul 2019
' enter your file names here:
' they must be found in the same directory as the file containing this code
Const APsource As String = "AP.xls"
Const PLsource As String = "Pl.xlsx"
Dim Fun() As String, Msg As String
Dim n As Integer ' counter of items not found
Dim Chk As Boolean
Dim Ap As Worksheet, Pl As Worksheet
Dim Rng As Range, Fnd As Range
Dim Arr As Variant ' values found in the row of Fnd
Dim Rl As Long ' Row(last)
Dim Tmp As Variant ' value of Pl.Cells(R, "A")
Dim Sp As Double
Dim R As Long ' Row
Dim C As Long ' Column
Chk = GetSheet(APsource, Ap)
If Chk Then Chk = GetSheet(PLsource, Pl)
If Chk Then
With Ap
Set Rng = .Range(.Cells(1, "E"), .Cells(.Rows.Count, "E").End(xlUp))
End With
Rl = Pl.Cells(Pl.Rows.Count, "A").End(xlUp).Row
ReDim Fun(Rl)
For R = 2 To Rl
Tmp = Pl.Cells(R, "A").Value
If Len(Trim(Tmp)) Then ' skip if empty
Set Fnd = Rng.Find(Tmp, Rng.Cells(Rng.Cells.Count), _
xlValues, xlWhole, xlByRows, xlNext, False)
If Not Fnd Is Nothing Then
' read values from range A:R in the row of Fnd
Arr = Fnd.Resize(1, Columns("R").Column).Value
Sp = WorksheetFunction.Max(Val(Arr(1, Columns("O").Column)), _
Val(Arr(1, Columns("P").Column)))
Sp = Sp * 1.05 * Abs(Val(Arr(1, Columns("L").Column))) + Val(Arr(1, Columns("R").Column))
C = 3
Do While Len(Pl.Cells(R, C).Value)
C = C + 1
Loop
With Pl.Cells(R, 3)
.Value = Sp
.NumberFormat = "#,##0.00" ' modify as required
End With
Else
Fun(n) = Tmp
n = n + 1
End If
End If
Next R
End If
If n Then
ReDim Preserve Fun(n - 1)
Msg = "The following items were not found:-" & String(2, vbCr) & _
Join(Fun, Chr(13))
Else
Msg = "All items were successfully updated."
End If
MsgBox Msg, vbInformation, "Action report"
On Error Resume Next
Pl.Parent.Close Chk ' save changes
Ap.Parent.Close False ' nothing changed, don't save
End Sub
Private Function GetSheet(ByVal Fn As String, _
Ws As Worksheet) As Boolean
' 27 Jul 2019
' return TRUE if the worksheet was set
Dim Wb As Workbook
On Error Resume Next
Set Wb = Workbooks(Fn)
If Err Then
Err.Clear
Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & Fn)
End If
If Err Then
MsgBox "The source file " & Chr(34) & Fn & Chr(34) & _
" couldn't be opened.", vbInformation, _
"Missing source file"
Else
Set Ws = Wb.Worksheets(1)
End If
GetSheet = Not CBool(Err)
End Function
I tried to use syntax you will understand and possibly modify. This was especially necessary since your description of columns doesn't match the numbers given for those columns in your original code. Note that syntax like Columns("L").Column is longhand for the number of column L. Of course, column L has the number 12. Therefore Arr(1, Columns("L").Column) equals Arr(1, 12) which would be a lot shorter and therefore more elegant but perhaps not as easily to understand and modify for a lay person or VBA novice.
Where permissable I used syntax like Cells(1, "E") where "E" also identifies the column and Excel doesn't need my code to convert the letter to a number. To modify, just change the letter.
Note that Arr() contains the values of one row. Excel makes this array two-dimensional by default. The first vector indicates the row number which is always 1 because there only is one row in this case.
The sourcefile names are entered at the top of the code by assigning the names to constants. You don't need to modify the code if the names change, just the values of the constants.
