PDA

View Full Version : VBA to Find and compare data from multiple columns



simora
01-14-2010, 03:49 AM
I am trying to match data on 2 columns from 2 workbooks. If data matches, do nothing, else, copy data from 1 workbook to the other.
Details on the attached spreadsheet MYBook1.xls

simora
01-14-2010, 03:53 AM
Sorry about that. Somehow, it didn't let me post a ZIP file with both workbooks.. Here's my 2nd workbook.

GTO
01-14-2010, 04:32 AM
Hi Simora,

While we have wb2 really looking at wb1 (leastwise as I read it), which wb is the "permanent" one?

I ask as I would think we'd want the code to go either in the wb to be retained, or in a third wb (or of course add-in etc).

Mark

simora
01-14-2010, 04:36 AM
Mark:
MyBook1 is the workbook where all the data gets posted to.( The permanent workbook.)

GTO
01-15-2010, 06:22 AM
Try:

Option Explicit

Sub exa()
Dim _
wbSource As Workbook, _
wksSource As Worksheet, _
wksDest As Worksheet, _
rngLRow As Range, _
rngSource As Range, _
rngDest As Range, _
rngFoundIt As Range, _
rCell As Range

Const START_ROW As Long = 2

'Set references to Source and Dest sheets. //
Set wbSource = Workbooks("MYBook2.xls")
Set wksSource = wbSource.Worksheets("Sheet1")
Set wksDest = ThisWorkbook.Worksheets("Sheet1")

'// Set reference to last row of in business names in source sheet. //
Set rngLRow = LastRow(wksSource, START_ROW, 2)
'// In case empty, bail. //
If rngLRow Is Nothing Then Exit Sub
'// Set reference to range of business names in source. //
Set rngSource = Range(wksSource.Range("B2"), rngLRow)

'//saa
Set rngLRow = LastRow(wksDest, START_ROW, 2)
If rngLRow Is Nothing Then Exit Sub
Set rngDest = Range(wksDest.Range("B2"), rngLRow)

'// for ea name in source, ... //
For Each rCell In rngSource
With rngDest
'// ...look for name,... //
Set rngFoundIt = .Find(What:=rCell.Value, _
After:=rngDest(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
'// ...if not found... //
If rngFoundIt Is Nothing Then
'// ...find first empty row in dest,... //
Set rngLRow = LastRow(wksDest, START_ROW, 2)
'// and place new info in destination. //
rngLRow.Offset(1).Resize(, 2).Value = rCell.Resize(, 2).Value
Else
'// But if found, test price, and if not same... //
If Not rngFoundIt.Offset(, 1) = rCell.Offset(, 1).Value Then

'// ...overwrite price. //
rngFoundIt.Offset(, 1).Value = rCell.Offset(, 1).Value
End If
End If
End With
Next
End Sub

Function LastRow(Sht As Worksheet, StartRow As Long, Col As Long) As Range
Dim wks As Worksheet

Set wks = Sht
With Sht
Set LastRow = .Range(.Cells(StartRow, Col), .Cells(Rows.Count, Col)) _
.Find(What:="*", _
After:=.Cells(StartRow, Col), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
End With
End Function

Hope that helps,

Mark

simora
01-15-2010, 01:28 PM
Mark:

The code work great for me. THANKS!
I'm trying to modify this bit for other sheets to accomadate a Range from Columns C to H rather than the one Column as done in this code.




'// and place new info in destination. //
rngLRow.Offset(1).Resize(, 2).Value = rCell.Resize(, 2).Value
Else
'// But if found, test price, and if not same... //
If Not rngFoundIt.Offset(, 1) = rCell.Offset(, 1).Value Then

'// ...overwrite price. //
rngFoundIt.Offset(, 1).Value = rCell.Offset(, 1).Value




The test for the names bit in Column B remains the same, but how do I structure this code bit to select and compare the range of cells ( Col C to H ) rather than the single cell. I dont have to evaluate all the cells in the newrange. If any of the cells in the range ( Col C to H ) is different in the 2nd sheet from the first sheet, then I can just copy the range over to the Original Sheet1

Thanks