VBA to compare two sheets and replace the value in sheet 1

Question

I have two Sheets , sheet1 and sheet2.

I am having 17 columns in sheet1 and 14 column in sheet2.

I have ID in column L of sheet1( the id starts with D2B and 4). one ID is 11 to 13 Digits Long, while the other is 8 Digit Long. In the endresult, i Need only ID with D2B.

In column L of sheet 2,I have ID only starting with 4. and it is 8digit Long. Also, I have Column A which Contains only D2B.

I am comparing both column (L) from sheet 1 and shee2. if the Id is present in sheet1 , then i copy the result to column M of sheet2. Since, I Need only Id with D2B, I check if column L and M of sheet 2 is matching, If they are matching, then I copy the corresponding ID d2B from column A of sheet 2 in column N.

Till this i have completed coding.

Now, I want to look into sheet 1, which ever is starting with ID 4, and it is found that It has coressponding D2C Id in sheet2, then it should be copied to column M of sheet1, if not found, then ID of Column L of sheet1 has to be copied in column M. Could anyone guide me , how i can do this

Below, is the code, i used for checking the value from sheet1 and pasting in sheet2.

Sub lookuppro()
Dim totalrows As Long
    Dim Totalcolumns As Long
    Dim rng As range

   totalrows = ActiveSheet.UsedRange.Rows.Count
    Sheets("Sheet2").Select
     For i = 1 To totalrows
     Set rng = Sheets("Sheet1").UsedRange.Find(Cells(i, 12).Value)
     'If it is found put its value on the destination sheet

       If Not rng Is Nothing Then
         Cells(i, 13).Value = rng.Value
          End If
         Next
End Sub

below is the code, i used for checking if they are matching and pasting the corresponding D2C number in sheet2.

Sub match()
Dim i               As Long
    Dim lngLastRow      As Long
    Dim ws              As Worksheet

    lngLastRow = range("A1").SpecialCells(xlCellTypeLastCell).Row

    Set ws = Sheets("Sheet2")

    With ws


        For i = 1 To lngLastRow
            If .Cells(i, 12).Value = .Cells(i, 13).Value Then
                .Cells(i, 14).Value = .Cells(i, 1).Value

            Else
             'nothing
            End If
        Next i
    End With
End Sub

Take a look at this: stackoverflow.com/questions/10714251/… And avoid using Select. So you could use Dim sht1, sht2 As Worksheet And on your code Set sht1 = ThisWorkbook.Worksheets("Sheet1") — danieltakeshi
You could check the first character or first 3 characters stackoverflow.com/questions/34713100/… And make a search through each Row with the For formula, extracting the rest of the ID String — danieltakeshi
@danieltakeshi with the usage of left i am looking for the first charachter in , How do i replacthe corresponding values from sheet2 to sheet1 ? sorry, I am new to VBA and thats why ? — Mikz
@danieltakeshi can you give me a test code ? may be ? I could work with it — Mikz

quadrature quadrature · Accepted Answer · 2017-06-28T03:29:23

I've integrated the comments from danieltakeshi in this solution. It isn't the most efficient, but it is easy to follow and shows two methods of achieving the same end. Comments are included in the code. In overarching terms, I've created a number of variables: two dedicated to each sheet, one to the search criteria, two to determine the extent of data in the L ranges, two to test cells in each range, a varible to cycle through rows and a variable to change search criteria with the Find function.

I've set the limits on the useful ranges, tested the matching pieces of info to put the D2C #s in Sheet 2 and then back into Sheet 1. I have some concern that your logic is duplicating itself without needing to, if you're extracting the same information twice...i.e., consider rethinking how this program is organized.

The code itself:

Sub check_values()

Dim sh1 As Worksheet, sh2 As Worksheet
Dim cell As Range, cell2 As Range, lstcl As Variant, lstcl2 As Variant, rgFnd As Variant
Dim n As Double, ID As String

Set sh1 = ThisWorkbook.Sheets(1)
Set sh2 = ThisWorkbook.Sheets(2)
ID = "4"

lstcl = sh1.Range("L10000").End(xlUp).Row
lstcl2 = sh2.Range("L10000").End(xlUp).Row

'comparing columns L in both sheets

For Each cell In sh2.Range("L1:L" & lstcl2)
    For n = 1 To lstcl
        If cell = sh1.Range("L" & n) Then

            'the cell in column M next to the matching cell is equal to the 4xxxxxxx number
            cell.Offset(0, 1) = sh1.Range("L" & n)

            'the next cell in column N is equal to the D2C number in column A
            cell.Offset(0, 2) = cell.Offset(0, -11)

        End If

    Next
Next

'test that each cell in the first sheet corresponds to the located results in the second sheet _
'and pastes back the D2C number, using the Range.Find function

For Each cell2 In sh1.Range("L1:L" & lstcl)
    If Left(cell2, 1) = ID Then
        Set rgFnd = sh2.Range("M1:M" & lstcl2).Find(cell2.Value)
            If Not rgFnd Is Nothing Then
                cell2.Offset(0, 1) = sh2.Range(rgFnd.Address).Offset(0, 1)
            End If
    End If
Next


End Sub

VBA to compare two sheets and replace the value in sheet 1

1 Answers