Untitled
Sub PullProductDescriptions() Dim wsCurrent As Worksheet Dim wsPrices As Worksheet Dim lastRowCurrent As Long Dim lastRowPrices As Long Dim currentCode As String Dim i As Long Dim matchRow As Range ' Set worksheets Set wsCurrent = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to the name of your current sheet Set wsPrices = ThisWorkbook.Sheets("Prices") ' Find the last rows in both sheets lastRowCurrent = wsCurrent.Cells(wsCurrent.Rows.Count, "A").End(xlUp).Row lastRowPrices = wsPrices.Cells(wsPrices.Rows.Count, "A").End(xlUp).Row ' Loop through each code in the current sheet For i = 2 To lastRowCurrent currentCode = wsCurrent.Cells(i, "A").Value ' Check if the code exists in the Prices sheet Set matchRow = wsPrices.Columns("A").Find(What:=currentCode, LookIn:=xlValues, LookAt:=xlWhole) ' If a match is found, pull the description from column B If Not matchRow Is Nothing Then wsCurrent.Cells(i, "B").Value = wsPrices.Cells(matchRow.Row, "B").Value Else wsCurrent.Cells(i, "B").Value = "Not Found" ' Optional: Add a placeholder if no match End If Next i MsgBox "Descriptions updated!", vbInformation End Sub
Leave a Comment