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

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.