VBA lookup and copy value to other column

MarktheShark

New Member
Joined
Feb 16, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
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
tempIDFound IDCopy value founded ID
x1
2
3
4
5
6
1​
7
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

kanadaaa

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows
Do you mean, if the value in B3 is 1, then:
1161903.xlsm
ABCD
1Table:
2ID
31
4tempIDfound IDCopy value found ID
5111
62
73
84
95
106
117
Sheet1

And if it is 2, then:
1161903.xlsm
ABCD
1Table:
2ID
32
4tempIDfound IDCopy value found ID
51
6222
73
84
95
106
117
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

New Member
Joined
Feb 16, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Do you mean, if the value in B3 is 1, then:
1161903.xlsm
ABCD
1Table:
2ID
31
4tempIDfound IDCopy value found ID
5111
62
73
84
95
106
117
Sheet1

And if it is 2, then:
1161903.xlsm
ABCD
1Table:
2ID
32
4tempIDfound IDCopy value found ID
51
6222
73
84
95
106
117
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

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows
Try this in a standard module:
VBA Code:
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

New Member
Joined
Feb 16, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Try this in a standard module:
VBA Code:
[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:
VBA Code:
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

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows
Do you mean, partway through the procedure the range should look like:
1161903.xlsm
ABCD
1Table:
2ID
32
4tempIDfound IDCopy value found ID
51
6x222
73
84
95
106
117
Sheet1

But when the macro finishes running it should look like below?
1161903.xlsm
ABCD
1Table:
2ID
32
4tempIDfound IDCopy value found ID
51
6222
73
84
95
106
117
Sheet1
 

kanadaaa

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Anyway, if so try this one:
VBA Code:
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

New Member
Joined
Feb 16, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
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

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Feb 16, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
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.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,825
Messages
5,766,659
Members
425,367
Latest member
Boboka

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top