VBA to find subtotal on Excel file opened on Teams sharepoint

[Tanyaann1995]

Hi Team,

I have a code which opens a file on Teams sharepoint and finds a part number in a column and then finds the subtotal of the inventory of that part and sends a message mentioning the amount of stock available for this item. But, when the file is opened on Teams, the code is not working entirely and the code stops running with an error in the below highlighted step. The error shown is "Type mismatch". Please help.

Sub pdc()

Dim i As Integer
Dim f As Workbook
Dim pno As String, Summary As String
Dim lastrow As Long
Dim Sum As Integer
Dim Rng As Range
Dim wb As Workbook
Dim xl As Object

Set wb = ActiveWorkbook
If wb.Worksheets(1).Range("G3").Value = 2 Then
MsgBox "This function is not applicable for complete valves."
End
End If

lastrow = wb.Worksheets("Emerson COMMERCIAL OFFER").Range("D:D").Find(What:="*", _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

sFileName = "https://share-test/Test quote"
Set xl = CreateObject("Excel.Application")
Set f = xl.Application.Workbooks.Open(Filename:=sFileName, ReadOnly:=True)
For i = 24 To lastrow
pno = wb.Worksheets("Emerson COMMERCIAL OFFER").Cells(i, 4).Value
f.Worksheets(1).Range("A1:L408").AutoFilter Field:=4, Criteria1:="=*" & pno & "*"
If f.Worksheets(1).AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 > 0 Then
With f.Worksheets(1)
Set Rng = .Range(.Cells(2, 10), .Cells(.Rows.Count, 10).End(xlUp))
End With
Sum = Application.WorksheetFunction.Subtotal(109, Rng)
Summary = Summary & pno & " - " & Sum & " pcs" & vbLf
Else
Summary = Summary & pno & " - " & "No stock in PDC" & vbLf
End If
Next i
wb.Worksheets("Emerson COMMERCIAL OFFER").Activate
f.Worksheets(1).ShowAllData
f.Close False
Set f = Nothing
MsgBox Summary


End Sub

 

[Tanyaann1995]

Hi Team,

I have a code which opens a file on Teams sharepoint and finds a part number in a column and then finds the subtotal of the inventory of that part and sends a message mentioning the amount of stock available for this item. But, when the file is opened on Teams, the code is not working entirely and the code stops running with an error in the below highlighted step. The error shown is "Type mismatch". Please help.

Sub pdc()

Dim i As Integer
Dim f As Workbook
Dim pno As String, Summary As String
Dim lastrow As Long
Dim Sum As Integer
Dim Rng As Range
Dim wb As Workbook
Dim xl As Object

Set wb = ActiveWorkbook
If wb.Worksheets(1).Range("G3").Value = 2 Then
MsgBox "This function is not applicable for complete valves."
End
End If

lastrow = wb.Worksheets("Emerson COMMERCIAL OFFER").Range("D:D").Find(What:="*", _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

sFileName = "https://share-test/Test quote"
Set xl = CreateObject("Excel.Application")
Set f = xl.Application.Workbooks.Open(Filename:=sFileName, ReadOnly:=True)
For i = 24 To lastrow
pno = wb.Worksheets("Emerson COMMERCIAL OFFER").Cells(i, 4).Value
f.Worksheets(1).Range("A1:L408").AutoFilter Field:=4, Criteria1:="=*" & pno & "*"
If f.Worksheets(1).AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 > 0 Then
With f.Worksheets(1)
Set Rng = .Range(.Cells(2, 10), .Cells(.Rows.Count, 10).End(xlUp))
End With
Sum = Application.WorksheetFunction.Subtotal(109, Rng)
Summary = Summary & pno & " - " & Sum & " pcs" & vbLf
Else
Summary = Summary & pno & " - " & "No stock in PDC" & vbLf
End If
Next i
wb.Worksheets("Emerson COMMERCIAL OFFER").Activate
f.Worksheets(1).ShowAllData
f.Close False
Set f = Nothing
MsgBox Summary


End Sub

Please help with the above.

 

[Tanyaann1995]

Please help with the above.

Hi Team,

Is there anyone who can help with the above code?