Macro for WS/WB comparisons, and copy/paste two cells based on matches

[kentlah]

Hi All,

I've been racking my brain for the last 5 days trying to solve this issue.

Synopsis - Every day I receive an Excel file from a batch output, and essentially my job is to raise work tasks based on the new errors. This means that every day I have to go through anywhere between 50-1000 records and matching them with yesterdays output. Firstly, I peruse column A for a matching number between the two, then when I find a match, if column E and column J match also (date format and free text respectively), I copy the cells from columns B, C and D of that row (a number, the work task number and date raised) in yesterdays sheet, into today's sheet.

Essentially I'm looking for a macro that:

Copies sheet 1 from yesterdays sheet into sheet 3 of todays sheet.
Compares the two sheets, based firstly on the NUMBER in column A, if match is found and value in cells E and J also match (date and text), then copy cells B, C and D for that row from sheet 3 (yesterdays) into sheet 1 (todays)
Important to note that the rows won't match based on row number but on cell values


Any help would be greatly appreciated.
I've been trying to reverse engineer the following code to at least get a start, but my 10+ years since using VB at school has taken me back to n00bdom. ;)

Sub MatchSheets()
Dim rng1 As Range
Dim rng2 As Range
Dim rng1J As Range
Dim rng2J As Range
Dim RowNo As Long

Set rng1 = Worksheets("Sheet1").Range("A1", Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
Set rng2 = Worksheets("Sheet2").Range("A1", Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp))
Set rng1J = Worksheets("Sheet1").Range("J1", Worksheets("Sheet1").Range("J" & Rows.Count).End(xlUp))
Set rng2J = Worksheets("Sheet2").Range("J1", Worksheets("Sheet2").Range("J" & Rows.Count).End(xlUp))
For Each c In rng1
If Not c.Value = "" And Application.WorksheetFunction.CountIf(rng2, c) > 0 And Application.WorksheetFunction.CountIf(rng2J, rng1J) > 0 Then
RowNo = Application.WorksheetFunction.Match(c, rng2)
If c.Offset(, 1).Value = "" Then c.Offset(, 1).Resize(1, 2).Value _
= Worksheets("Sheet2").Range("B" & RowNo, "C" & RowNo).Value
End If
Next c

End Sub

I've also attached a spreadsheet just to show what I mean. (Because I'm a nice guy)

Any help is appreciated!

[mancubus]

hi nice guy.
wellcome to VBAX.

here is a piece of nice code.
test it with a copy of your file.


Sub CompareTwoSheets()

Dim wbToday As Workbook, wbYesterday As Workbook
Dim ws1 As Worksheet, ws3 As Worksheet, wsToCopy As Worksheet
Dim rng1 As Range, rng3 As Range, c1 As Range, c3 As Range

On Error Resume Next
Set wbToday = ThisWorkbook
Set wbYesterday = Workbooks("yesterday.xls") 'change to suit
If wbYesterday Is Nothing Then
Set wbYesterday = Workbooks.Open("C:\Users\MyName\Documents\yesterday.xls") 'change to suit
End If
On Error GoTo 0

Set ws1 = wbToday.Worksheets("Sheet1")
Set ws3 = wbToday.Worksheets("Sheet3")
Set wsToCopy = wbYesterday.Worksheets("Sheet1")

wsToCopy.UsedRange.Copy ws3.Range("A1")
wbYesterday.Close False

Set rng1 = ws1.Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rng3 = ws3.Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)

For Each c1 In rng1
Set c3 = rng3.Find(what:=c1.Value)
If Not c3 Is Nothing Then
If ws1.Cells(c1.Row, "E") = ws3.Cells(c3.Row, "E") And ws1.Cells(c1.Row, "J") = ws3.Cells(c3.Row, "J") Then
ws3.Range("B" & c3.Row & ":D" & c3.Row).Copy ws1.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
End If
End If
Next

End Sub

[kentlah]

cool!
thanks very much for the code :-)
I'll start testing it tonight!!

(and apologies for the late reply, I've been shipped off elsewhere this week for work and haven't had a chance to check for replies!)

[mancubus]

you're wellcome.

correction:
change
Set rng1 = ws1.Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rng3 = ws3.Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row

to
Set rng1 = ws1.Range("A2:A" & ws1.Cells(Rows.Count, "A").End(xlUp).Row)
Set rng3 = ws3.Range("A2:A" & ws3.Cells(Rows.Count, "A").End(xlUp).Row

[kentlah]

I get a run-time error '9': Subscript out of range error when it hits this line:

Set ws3 = wbToday.Worksheets("Sheet3")

I've tried fixing it myself (with my limited knowledge) but to no avail. :dunno

Thanks again for your help :beerchug:

[mancubus]

first to check is whether that worksheet exists...
if exists, check if written correctly...