Excel VBA - Find a value and place in a different sheet

Question

I am an absolute novice trying to make a macro that takes an item from cell A2 in sheet "WHO", assigns the value from cell B2 from the same sheet. Inserts a new column in sheet "BO" with name from cell B1 of sheet "WHO". Finds a match of the item from cell A2/ sheet "WHO" in sheet "BO", checks the quantity corresponding to the item, if it is equal to the value of cell B2 from sheet "WHO" and puts it in the new column if not, puts the found quantity of value from sheet "WHO" and continues to search for the next match of an item until you have distributed all the pieces. Now even I was confused, so I attach the code that I managed to assemble from different places :)

Sub BO_WHO_Format()

Dim I           As Integer
Dim rngFound    As Range, strFirst, Name As String
Dim pNum, vNum, lr As Long

Name = Worksheets("WHO").Range("B1")

lr = Worksheets("WHO").Cells(Rows.Count, "A").End(xlUp).Row        ' Find the last row with data in column A..

With Worksheets("BO").Columns(16)
    
    Application.CutCopyMode = FALSE
    Sheets("BO").Select
    Columns("AC:AC").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AC1").Select
    ActiveCell.FormulaR1C1 = "На път"
    Range("AC2").Value = Name
    
    For I = 2 To lr
        
        strFirst = ""        'Clear the value assigned to strFirst.
        
        Dim Check As Boolean, Counter As Long, Total As Long
        
        Check = False: Counter = 0: Total = 0        ' Initialize variables.
        
        Do        ' Outer loop.
            
            pNum = Sheets("WHO").Range("A" & I).Value
            vNum = Sheets("WHO").Range("B" & I).Value
            
            If IsNumeric(pNum) Then pNum = Val(pNum)
            
            If IsNumeric(vNum) Then vNum = Val(vNum)
            
            Set rngFound = .Find(what:=pNum, LookAt:=xlWhole, SearchDirection:=xlNext, After:=.Cells(1), MatchCase:=False)
            
            If rngFound Is Nothing Then
                
                MsgBox "Номер " & pNum & " не е намерен! Проверете и започнете отново!"
                
                Sheets("BO").Select
                Columns("AB:AB").Select
                Selection.Delete Shift:=xlToLeft
                
                Exit Sub
                
            ElseIf rngFound.Offset(, 11).Value = 0 Then GoTo NextIteration        'If value is 0
            
            MsgBox "Виж си кода за грешки"
            
        ElseIf rngFound.Offset(, 11).Value >= vNum Then        'If value is the same
        
        rngFound.Offset(, 13) = vNum
        
    Else
        
        rngFound.Offset(, 13) = rngFound.Offset(, 11).Value
        Counter = Counter + rngFound.Offset(, 11).Value        ' Increment Counter.
        NextIteration:
        
        strFirst = rngFound.Address        ' Assign the address of the first item found, so code will know if it has finished looking.
        
        Do While Counter < vNum        ' Inner Loop
            
            Total = vNum - Counter
            Set rngFound = .FindNext(rngFound)
            
            If Not rngFound Is Nothing And strFirst <> rngFound.Address Then        'strFirst = rngFound.Address        ' Assign the address of the first item found, so code will know if it has finished looking.
            
            If rngFound.Offset(, 11).Value = 0 Then GoTo NextError
            If rngFound.Offset(, 11).Value <= Total Then
                
                rngFound.Offset(, 13) = rngFound.Offset(, 11).Value
                Counter = Counter + rngFound.Offset(, 11).Value        ' Increment Counter.
                
            Else
                
                rngFound.Offset(, 13) = Total
                Counter = Counter + rngFound.Offset(, 11).Value        ' Increment Counter.
            End If
            
        Else
            NextError:
            
            MsgBox "Номер " & pNum & " не е намерен! Проверете и започнете отново!"
            
            Sheets("BO").Select
            Columns("AB:AB").Select
            Selection.Delete Shift:=xlToLeft
            
            Exit Sub
            
        End If
        
    Loop        ' Inner Loop
    
End If

Loop Until Check = FALSE        ' Exit outer loop immediately.

Next I

End With

End Sub

If the number is not found, the quantity in the sheet "WHO" is greater than the sheet "BO" to delete the newly created column in the sheet "BO" and the macro to terminate with a message. There are no duplicate item in a sheet "WHO", unlike the "BO" sheet. But I'm totally stuck, please help.

sheet "WHO"

sheet "BO"

Answer 1

I hope I understood all what you need. Have a try of the code:

Option Explicit

Sub BO_WHO_Format()
'worksheets
Dim boSht As Worksheet, whoSht As Worksheet
Set boSht = ThisWorkbook.Sheets("BO")
Set whoSht = ThisWorkbook.Sheets("WHO")

'search ranges
Dim boRange As Range, boCell As Range, whoRange As Range, whoCell As Range
With boSht
    'column A, starting from 2-d row
    Set boRange = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
With whoSht
    'column P,starting from 2-d row
    Set whoRange = Range(.Cells(2, 16), .Cells(Rows.Count, 16).End(xlUp))
End With

'other variables
Dim hasMatch As Boolean
Dim row As Long

'taking each value in column A of the WHO sheet
For Each whoCell In whoRange
    'and comparing to each values in column P of the BO sheet
    For Each boCell In boRange
    
        If whoCell = boCell Then
        
            row = boCell.row
        
            If Not hasMatch Then
                'set the AB column name of the sheet BO as like the name of column B of the WHO sheet
                boSht.Cells(1, 28) = whoSht.Cells(1, 2)
                hasResult = True
            End If
            
            'if value from column B of the sheet WHO equals to value from column AA of the sheet BO
            If whoCell.Offset(0, 1).Value = boSht.Cells(row, 27).Value Then
                'put this value to column AB
                boSht.Cells(row, 28).Value = whoCell.Offset(0, 1).Value
            Else
                'otherwise if value is not 0
                If Not boSht.Cells(row, 27).Value = 0 Then
                    'put the value from column AA to column AB
                    boSht.Cells(row, 28).Value = boSht.Cells(row, 27).Value
                End If
            End If
            
        End If
        
    Next
    
Next

'check whether there is a match
If Not hasMatch Then
    boSht.Cells(1, 28) = ""
    MsgBox "No matches!", vbInformation, "Result"
End If

End Sub

See comments in code, in case something is not exactly what you wanted - I pointed an idea, so you can modify it for your needs.