VBA to loop through cells and add message

Tanyaann1995

New Member
Joined
Mar 24, 2021
Messages
49
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I have a list of part numbers in Column D in a workbook. I need the code to check the stock for each part number by selecting each part number and then checking for the stock in another file. Once it gets the stock quantity, I need a message box to pop up saying that this item has .... pieces in stock. I have developed below code for it:

VBA Code:

Sub pdc()
Dim i As Integer
Dim f As Workbook
Dim pno As String
Dim lastrow As Long
Dim Sum As Integer
Dim rng As Range

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

For i = 24 To lastrow
pno = ThisWorkbook.Worksheets(2).Cells(i, 4).Value
Set f = Workbooks.Open("\\emrsn.org\VC-Drive_N\AEDU1_QUOTATIONS\Quotes FY 2021\MRO\TANYA\3 PRICING-SN-PN TOOLS\JDI_PDC_Onhand_P08 End.xlsx", True, True)
f.Worksheets(1).Range("A1:H422").AutoFilter Field:=1, 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, 6), .Cells(.Rows.Count, 13).End(xlUp))
End With
Sum = Application.WorksheetFunction.Subtotal(109, rng)
MsgBox pno & " - " & Sum & " pcs"
Else
MsgBox pno & " - " & "No stock in PDC"
End If
Next i
End Sub

This code will display a message box for each part number but I want to display 1 message box with all the part numbers and its corresponding stock quantity. How do i change the code in that case?
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,618
Office Version
  1. 2016
Platform
  1. Windows
Try this but Msgbox has characters limit. The Set f statement no need to be in loop. Otherwise it kept being open over and over again :)
VBA Code:
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

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

Set f = Workbooks.Open("\\emrsn.org\VC-Drive_N\AEDU1_QUOTATIONS\Quotes FY 2021\MRO\TANYA\3 PRICING-SN-PN TOOLS\JDI_PDC_Onhand_P08 End.xlsx", True, True)
For i = 24 To lastrow
    pno = ThisWorkbook.Worksheets(2).Cells(i, 4).Value
    f.Worksheets(1).Range("A1:H422").AutoFilter Field:=1, 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, 6), .Cells(.Rows.Count, 13).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

MsgBox Summary

End Sub
 

Tanyaann1995

New Member
Joined
Mar 24, 2021
Messages
49
Office Version
  1. 2016
Platform
  1. Windows
Try this but Msgbox has characters limit. The Set f statement no need to be in loop. Otherwise it kept being open over and over again :)
VBA Code:
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

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

Set f = Workbooks.Open("\\emrsn.org\VC-Drive_N\AEDU1_QUOTATIONS\Quotes FY 2021\MRO\TANYA\3 PRICING-SN-PN TOOLS\JDI_PDC_Onhand_P08 End.xlsx", True, True)
For i = 24 To lastrow
    pno = ThisWorkbook.Worksheets(2).Cells(i, 4).Value
    f.Worksheets(1).Range("A1:H422").AutoFilter Field:=1, 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, 6), .Cells(.Rows.Count, 13).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

MsgBox Summary

End Sub
Thanks :) This worked perfectly.
 

Forum statistics

Threads
1,141,715
Messages
5,708,032
Members
421,540
Latest member
quocbinh

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top