HELP: Match values from different sheets and populate a column

[Sam]

Hi All, How can I compare values from Sheet1 ColumnA and Sheet2 ColumnA and
populate Sheet1 Columnb accordingly?

For eg: ColumnA in sheet1 and Sheet2 have the same values, But there are
instances where certain cells in Sheet2 columnA are left blank.

here is the eg:
Sheet1:
ColumnA
ann taylor 1
ben coy22
can loy 2
den zen
eno zor
fan tan4 c

Sheet2:
ColumnA ColumnB
ann taylor 1 11
ben coy22 12

can loy 2 13
den zen
eno zor 16
fan tan4 c

so there are blank rows between b&c and between d&e also there is no value
for d and f and hence it should not display any value for d and f in Sheet1
ColumnA

Here is how the Data in Sheet1 should look like:

Sheet1
ColumnA ColumnB
ann taylor 1 11
ben coy22 12
can loy 2 13
den zen
eno zor 16
fan tan4 c

Hope I made it clear

Thanks in advance

 

[Per Jessen]

Hi

This should do it:

Sub PopulateSheet()
Dim TargetSh As Worksheet
Dim DestSh As Worksheet
Dim TargetRng As Range
Dim DestRng As Range

Set TargetSh = Worksheets("Sheet2")
Set DestSh = Worksheets("Sheet1")
Set DestRng = DestSh.Range("A1", DestSh.Range("A" & Rows.Count).End(xlUp))
Set TargetRng = TargetSh.Range("A2", TargetSh.Range("A" &
Rows.Count).End(xlUp))
' Headings in row 1

For Each cell In TargetRng
If cell.Value <> "" Then
Set f = DestRng.Find(what:=cell.Value, _
after:=DestSh.Range("A1"), LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
f.Offset(0, 1) = cell.Offset(0, 1).Value
End If
End If
Next
End Sub

Regards,
Per

 

[Joel]

Sub GetData()


With Sheets("sheet1")
RowCount = 1
Do While .Range("A" & RowCount) <> ""
ColHeader = .Range("A" & RowCount)
With Sheets("sheet2")
Set c = .Columns("A").Find(what:=ColHeader, _
LookIn:=xlValues, lookat:=xlWhole)
End With
If Not c Is Nothing Then
data = Trim(c.Offset(0, 1).Value)
If data <> "" Then
.Range("B" & RowCount) = data
End If
End If
RowCount = RowCount + 1
Loop

End With


End Sub

 

[john]

Hi Sam,
see if this does what you want.

Sub GetSamsData()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim StartRow As Long
Dim EndRow As Long
Dim Lr As Long
Dim FoundCell As Range

With ThisWorkbook

Set ws1 = .Worksheets("Sheet1")
Set ws2 = .Worksheets("Sheet2")

End With

'ignore header
StartRow = 2

With ws2

EndRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For Lr = EndRow To StartRow Step -1

Search = .Cells(Lr, 1).Value

If Search <> "" Then

Set FoundCell = ws1.Columns(1).Find(Search, _
LookIn:=xlValues, _
LookAt:=xlWhole)

If FoundCell Is Nothing = False Then

FoundCell.Offset(0, 1).Value = .Cells(Lr, 2).Value

End If
End If

Next

End With

End Sub