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]

Do you mean, if the value in B3 is 1, then:

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

And if it is 2, then:

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

Like these?
P.S.
Why do you need the temp x anyway? It seems to me like it's doing no important job in the procedure.

 

[MarktheShark]

Do you mean, if the value in B3 is 1, then:

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

And if it is 2, then:

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

Like these?
P.S.
Why do you need the temp x anyway? It seems to me like it's doing no important job in the procedure.

Hi, thank you for looking into my request, I appreciate that very much!

Cell B3 is a lookup in column A and checks if there is an "x" found then set ID in cell B3.
Formula: =Vlookup("x";$A$5:$B$1048576;2;FALSE) .

Your conclusion in the second table "And if it is 2, then:" is right. That's exactly what I want

 

[kanadaaa]

Try this in a standard module:

Sub CopyID()
    Dim fnd As Range, lastRow As Long
    lastRow = Range("B" & Rows.Count).End(xlUp).Row
    Set fnd = Range("B5:B" & lastRow).Find(Range("B3"), , xlValues, xlWhole)
    If Not fnd Is Nothing Then
        If fnd.Address <> "$B$3" Then
            Range("A5").Resize(7, 1).Value = ""
            Range("C5").Resize(7, 2).Value = ""
            Range("C" & fnd.Row).Resize(, 2).Value = fnd
        Else
            MsgBox "No match found."
        End If
    Else
        MsgBox "No match found."
    End If
End Sub

 

[MarktheShark]

Try this in a standard module:

[QUOTE="kanadaaa, post: 5639687, member: 455294"]
Try this in a standard module:
[CODE=vba]
Sub CopyID()
    Dim fnd As Range, lastRow As Long
    lastRow = Range("B" & Rows.Count).End(xlUp).Row
    Set fnd = Range("B5:B" & lastRow).Find(Range("B3"), , xlValues, xlWhole)
    If Not fnd Is Nothing Then
        If fnd.Address <> "$B$3" Then
            Range("A5").Resize(7, 1).Value = ""
            Range("C5").Resize(7, 2).Value = ""
            Range("C" & fnd.Row).Resize(, 2).Value = fnd
        Else
            MsgBox "No match found."
        End If
    Else
        MsgBox "No match found."
    End If
End Sub

Try this in a standard module:

Sub CopyID()
    Dim fnd As Range, lastRow As Long
    lastRow = Range("B" & Rows.Count).End(xlUp).Row
    Set fnd = Range("B5:B" & lastRow).Find(Range("B3"), , xlValues, xlWhole)
    If Not fnd Is Nothing Then
        If fnd.Address <> "$B$3" Then
            Range("A5").Resize(7, 1).Value = ""
            Range("C5").Resize(7, 2).Value = ""
            Range("C" & fnd.Row).Resize(, 2).Value = fnd
        Else
            MsgBox "No match found."
        End If
    Else
        MsgBox "No match found."
    End If
End Sub

This code works partly.

The code must also set a "x" to the cell in column A and loop trough.

Is this something you can add to the code?
[/CODE]
[/QUOTE]

 

[kanadaaa]

Do you mean, partway through the procedure the range should look like:

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

But when the macro finishes running it should look like below?

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

 

[kanadaaa]

Anyway, if so try this one:

Sub CopyIDMod()
    Dim fnd As Range, lastRow As Long
    lastRow = Range("B" & Rows.Count).End(xlUp).Row
    Set fnd = Range("B5:B" & lastRow).Find(Range("B3"), , xlValues, xlWhole)
    If Not fnd Is Nothing Then
        If fnd.Address <> "$B$3" Then
            Range("A" & fnd.Row).Value = "x"
            Range("C5").Resize(lastRow - 4, 2).Value = ""
            Range("C" & fnd.Row).Resize(, 2).Value = fnd
            Range("A5").Resize(lastRow - 4, 1).Value = ""
        Else
            Range("A5").Resize(lastRow - 4, 1).Value = ""
            Range("C5").Resize(lastRow - 4, 2).Value = ""
            MsgBox "No match found."
        End If
    Else
        Range("A5").Resize(lastRow - 4, 1).Value = ""
        Range("C5").Resize(lastRow - 4, 2).Value = ""
        MsgBox "No match found."
    End If
End Sub

You can't see x showing up if you just run the macro so use F8.

 

[MarktheShark]

Sub CopyIDMod() Dim fnd As Range, lastRow As Long lastRow = Range("B" & Rows.Count).End(xlUp).Row Set fnd = Range("B5:B" & lastRow).Find(Range("B3"), , xlValues, xlWhole) If Not fnd Is Nothing Then If fnd.Address <> "$B$3" Then Range("A" & fnd.Row).Value = "x" Range("C5").Resize(7, 2).Value = "" Range("C" & fnd.Row).Resize(, 2).Value = fnd Range("A5").Resize(7, 1).Value = "" Else Range("A5").Resize(7, 1).Value = "" Range("C5").Resize(7, 2).Value = "" MsgBox "No match found." End If Else Range("A5").Resize(7, 1).Value = "" Range("C5").Resize(7, 2).Value = "" MsgBox "No match found." End If End Sub

I think we are almost there. When I run the code by F8 it gives an error because it's missing an "x" in column A.
Therefore must be in the code to add first an "x" and then do the lookup, etc. If possible in a loop.

I hope I don't demand too much

 

[kanadaaa]

Temp x isn't there before and after running the macro so whatever way you run it vlookup will show you an error.
Are you trying to incorporate this code into another? If so I think I can make sense of what you're trying to do though.
If not, adding the temp x would be meaningless since it won't resolve the error of vlookup.

 

[MarktheShark]

Temp x isn't there before and after running the macro so whatever way you run it vlookup will show you an error.
Are you trying to incorporate this code into another? If so I think I can make sense of what you're trying to do though.
If not adding the temp x would be meaningless since it won't revolve the error of vlookup.

There is no other VBA code, only a vlookup formula in column C "=ALS(B6=$B$2;" ";ALS(EN(H6>$F$2;H6<$G$2;M6=$I$2;N6>$M$2;N6<$N$2);$B$2;""))".
This checks if the conditions of the row in column A with an "x" are equal to other rows and if there are equal then set the ID number in column C.
Manually I copy the number into column D.

The loop is necessary because there are in total 150.000 rows.