Vba Code contains Error

0
Sub code()
Set pl = Workbooks.Open(ThisWorkbook.Path & "\PL.xlsx").Sheets(1)
Set ap = Workbooks.Open(ThisWorkbook.Path & "\ap.xls").Sheets(1)
rw = 2
lr = pl.Cells(pl.Rows.Count, 1).End(xlUp).Row
Do Until rw = lr
    Set fnd = ap.Range("E:E").Find(pl.Cells(rw, 1))
    If Not fnd Is Nothing Then
    sp = fnd.Offset(, 10)
    If fnd.Offset(, 11) > sp Then sp = fnd.Offset(, 11)
      pl.Cells(rw, 3) = Abs(sp * 1.05 * fnd.Offset(, 7) + fnd.ofset(, 13))


    Else
'    MsgBox pl.Cells(rw, 1) & " not found"
    End If
    rw = rw + 1
Loop
pl.Parent.Close True  ' save changes
ap.Parent.Close False   ' nothing changed, don't save

End Sub

Problem- If column E of ap.xls matches with column A of PL.xlsx then look column O of ap.xls and column P of ap.xls & if column O of ap.xls is higher then calculate the 0.50% of column O of ap.xls or if column P of ap.xls is higher then calculate the 0.50% of that and multiply the same with column L of ap.xls(column L can contain - minus sign so ignore that or it will not contain any sign with numbers so we have to look only the numbers) and add that data to Column R of ap.xls and paste the result to PL.xlsx from column C(if column C has data then paste to column D and if Column D has then column E and so on)

Vba is placed in a different file
all files are located in same path

ap.xls and PL.xlsx has headers so ignore the first row

Sir/Mam Plz have a look into the code this code contains an error

Error- Run-time error '438':

Object doesn't support this property or method

Answer
Discuss

Answers

0
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.

Discuss

Discussion

where i have to put this code and how i have to put plz let me know mam
Select All
For rw = 2 To lr
...
Next rw

style36 (rep: 24) Jul 25, '19 at 12:38 am
For rw = 2 To lr
would replace 
Do Until rw = lr

And 
Next rw
would replace 
Loop


You don't have to make this change, but it allows you to reduce some of the code, which makes maintaining things easier in the long-run; you would no longer need to inrement rw at the end of the loop or set it before the loop.
don (rep: 1715) Jul 25, '19 at 10:40 am
Sub code()
Set pl = Workbooks.Open(ThisWorkbook.Path & "\PL.xlsx").Sheets(1)
Set ap = Workbooks.Open(ThisWorkbook.Path & "\ap.xls").Sheets(1)
rw = 2
lr = pl.Cells(pl.Rows.Count, 1).End(xlUp).Row
For rw = 2 To lr
    Set fnd = ap.Range("E:E").Find(pl.Cells(rw, 1))
    If Not fnd Is Nothing Then
    sp = fnd.Offset(, 10)
    If fnd.Offset(, 11) > sp Then sp = fnd.Offset(, 11)
      pl.Cells(rw, 3) = Abs(sp * 1.05 * fnd.Offset(, 7) + fnd.ofset(, 13))
 
 
    Else
'    MsgBox pl.Cells(rw, 1) & " not found"
    End If
    rw = rw + 1
Next rw
pl.Parent.Close True  ' save changes
ap.Parent.Close False   ' nothing changed, don't save
 
End Sub




After changing the details the code gets an error
Error highlighted line-   pl.Cells(rw, 3) = Abs(sp * 1.05 * fnd.Offset(, 7) + fnd.ofset(, 13))
Error Name-Run-time error '438' Object doesn't support this property or method
style36 (rep: 24) Jul 25, '19 at 1:44 pm
If it is causing an error, you can just revert to using the old code, this change is optional. It's hard to read big code in comments. If you edit your question and upload sample files, I can take a look, but, the fastest solution may be to revert to the old loop style for the moment.
don (rep: 1715) Jul 26, '19 at 8:41 am
I have added my files to the first post of this thread so plz have a look 
style36 (rep: 24) Jul 26, '19 at 2:05 pm
after runing this code i am getting incorrect calculation result
plz have a look into  my problem once again and test this code on my sample file and see the PL.xlsx file (the result pastes is incorrect)

My Problem -  If column E of ap.xls matches with column A of PL.xlsx then look column O of ap.xls and column P of ap.xls & if column O of ap.xls is higher then calculate the 0.50% of column O of ap.xls or if column P of ap.xls is higher then calculate the 0.50% of that and multiply the same with column L of ap.xls(column L can contain - minus sign so ignore that or it will not contain any sign with numbers so we have to look only the numbers) and add that data to Column R of ap.xls and paste the result to PL.xlsx from column C(if column C has data then paste to column D and if Column D has then column E and so on) Vba is placed in a different file
all files are located in same path

ap.xls and PL.xlsx has headers so ignore the first row
style36 (rep: 24) Jul 27, '19 at 1:47 pm
Hello Style, I have taken great pains to write the code in such a way as to enable you to make any changes yourself, especially to the calculation, which I neither checked, nor can check, nor have any intention of checking. Please bear in mind that this isn't a free code writing service. I don't communicate with you by copy/pasting what I said before and I don't consider it polite on your part to do so either. The entire calculation is contained in just two lines of code. I don't think it is asking too much of you just to look at them for two minutes. You'll understand. Then, if you have a specific question about one of these lines I shall look at your request, provided it doesn't look like a demand. And BTW, I think this thread has already taken enough space and time. Close it down and start another, if you must.
Variatus (rep: 2958) Jul 28, '19 at 12:05 am
Thnx Alot Mam and Sir for giving ur precious time and great support to this post
style36 (rep: 24) Jul 28, '19 at 2:26 pm
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login