VBA lookup and copy value to other column

[MarktheShark]

Hi everyone, I want to automate manual handling in VBA but ran into some issues. Hopefully, you can help me with this.

In general:
In column "temp" I set a "x" and a lookup formula checks if in column "ID" is the same value. If there is the same value then copy this to column "Copy value founded ID".
The next step is to delete the "x" in "temp" column and go to the next row.

The only thing I want to automate is this:
- set an "x" to fifth row in column "temp"
- look if there is a value found in column "Found ID"
- If so then copy found value to the next column "Copy value founded ID" and the SAME row
- delete the "x" in "temp" column
- go to the next row and repeat above

Code so far:
Sub Find_ID()

Dim wb As Workbook
Dim ws As Worksheet
Dim FoundCell As Range
Set wb = ActiveWorkbook
Set ws = ActiveSheet
Set WHAT_TO_FIND = Range("B2")

For x = 5 To 10
Range("A" & x).Value = "x"

Set FoundCell = ws.Range("C3:C100").Find(what:=WHAT_TO_FIND)
If Not FoundCell Is Nothing Then

'copy to next column - same row
End If

Next x
End Sub

Table:

	ID
	1
temp	ID	Found ID	Copy value founded ID
x	1
	2
	3
	4
	5
	6	1​
	7

 

[kanadaaa]

"=ALS(B6=$B$2;" ";ALS(EN(H6>$F$2;H6<$G$2;M6=$I$2;N6>$M$2;N6<$N$2);$B$2;""))"

This isn't a grammatical formula, so maybe:

1161903.xlsm
	A	B	C	D
1	Table:
2		ID
3		7
4	temp	ID	found ID	Copy value found ID
5		1
6		2
7		3
8		4
9		5
10		6
11		7	7	7
Sheet1

Cell Formulas
Range	Formula
C3	C3	=IF(B6=$B$2," ",IF(AND(H6>$F$2,H6<$G$2,M6=$I$2,N6>$M$2,N6<$N$2),$B$2,""))

But this makes it even more confusing because there are references to B2 and B6, which do nothing.

 

[MarktheShark]

This isn't a grammatical formula, so maybe:

1161903.xlsm
	A	B	C	D
1	Table:
2		ID
3		7
4	temp	ID	found ID	Copy value found ID
5		1
6		2
7		3
8		4
9		5
10		6
11		7	7	7
Sheet1

Cell Formulas
Range	Formula
C3	C3	=IF(B6=$B$2," ",IF(AND(H6>$F$2,H6<$G$2,M6=$I$2,N6>$M$2,N6<$N$2),$B$2,""))

But this makes it even more confusing because there are references to B2 and B6, which do nothing.

View attachment 32214

I know, I only send a part of the table because the other data in the table is privacy sensitive.
You can ignore the formula, that is working fine.
I hope you can add a loop into the code and that an 'x' is set everytime a new row is selected.

 

[kanadaaa]

Unfortunately I can't at this rate because I still don't understand what you're trying to do.
When you tried the code above using F8, I guess you saw for a moment what you're trying to do.
But that's gone when the macro finishes running because x vanishes after running the macro.
There's thus no way to keep the value you want with a formula.
You're going to need a code to achieve that, as long as I can imagine.
Importantly, writing a code requires a rough picture of the entire things that one is pursuing, but I can't see that.

 

[MarktheShark]

Unfortunately I can't at this rate because I still don't understand what you're trying to do.
When you tried the code above using F8, I guess you saw for a moment what you're trying to do.
But that's gone when the macro finishes running because x vanishes after running the macro.
There's thus no way to keep the value you want with a formula.
You're going to need a code to achieve that, as long as I can imagine.
Importantly, writing a code requires a rough picture of the entire things that one is pursuing, but I can't see that.

I'm sorry if the requirements are a little bit confusing.

I changed your code and it's in a loop now and it's working almost perfectly. Only 1 thing still goes wrong.
When there is found a matching record or not, the "x" in column A must be deleted before to go to the next row.

I solved this by deleting a range in column A (Range("A5:A30").Resize.Value = ""), but I think there is a better way to do this. Like only deleting the cell with the "x".
Maybe you have a solution for this. If so that will be very helpful.

Code
Sub CopyIDMod()
Dim fnd As Range, lastRow As Long
lastRow = Range("B" & Rows.Count).End(xlUp).row
Dim Cl As Range


With Sheets("Blad3")
For x = 5 To 27
Range("A" & x).Value = "x"


Set fnd = Range("C5:C" & lastRow).Find(Range("B2"), , xlValues, xlWhole)
If Not fnd Is Nothing Then
If fnd.Address <> "$B$2" Then
Range("C" & fnd.row).Resize(, 2).Value = fnd
Range("A5:A30").Resize.Value = ""

Else

Range("A5:A30").Resize.Value = ""
' MsgBox "No match found."
End If
Else

Range("A5:A30").Resize.Value = ""

End If


Next
End With
End Sub

 

[kanadaaa]

Before posting another code, there are a few things I'd request you to follow.

1) Please use the code-wrapping function of the forum when you post a code because codes not wrapped are hard to see.
2) Please provide the exact information as to what value is in what cell. For example, I have been assuming the search value for the FIND property is in cell B3, but the code you modified says it's in cell B2. It will be a waste of our time if we have to guess and modify our test workbooks because of your inaccurate information.
3) Please use polite language because we are volunteers. For example, "I would appreciate it if you could share a workaround for this" is much better than "I think there's a better way to do this".

Make 100% sure that you understand all of the above before proceeding to the code below.

Sub CopyIDMod2()
    Dim fnd As Range, lastRow As Long, x As Long
    lastRow = Range("B" & Rows.Count).End(xlUp).Row
    Sheets("Blad3").Activate
    With ActiveSheet
        Application.ScreenUpdating = False
        For x = 5 To lastRow
            .Range("A" & x).Value = "x"
            Set fnd = .Range("C5:C" & lastRow).Find(.Range("B2"), , xlValues, xlWhole)
            If Not fnd Is Nothing Then
                .Range("C" & fnd.Row).Resize(, 2).Value = fnd
            End If
            .Range("A" & x).Value = ""
        Next x
        Application.ScreenUpdating = True
    End With
End Sub

 

[MarktheShark]

Sub CopyIDMod2() Dim fnd As Range, lastRow As Long, x As Long lastRow = Range("B" & Rows.Count).End(xlUp).Row Sheets("Blad3").Activate With ActiveSheet Application.ScreenUpdating = False For x = 5 To lastRow .Range("A" & x).Value = "x" Set fnd = .Range("C5:C" & lastRow).Find(.Range("B2"), , xlValues, xlWhole) If Not fnd Is Nothing Then .Range("C" & fnd.Row).Resize(, 2).Value = fnd End If .Range("A" & x).Value = "" Next x Application.ScreenUpdating = True End With End Sub

I understand the rules, my apologies if I have not followed them correctly. It is the 1st time that I am posting here and my native language is not English so maybe I used the wrong words.
It was never meant to be unrespectful.

I want to thank you for your help, you helped me a lot. Many thanks.

 

[kanadaaa]

I want to thank you for your help, you helped me a lot. Many thanks.

Does the code actually work the way you want it to?

 

[MarktheShark]

Does the code actually work the way you want it to?

Yes, the code works perfectly.
Well done and thank you for your effort and time!