Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
Old January 12th, 2012, 07:24 AM
Registered User
Join Date: Jan 2012
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default Need a Macro for Compare and copy data from one sheet to another sheet in Excel.

Hi All,

I am new to Excel Macros and need experts Help, I was stuck up at Compare and copy data from one sheet to another sheet in Excel 2007.

I have a excel workbook which contains 3 sheets(sheet1 , sheet2 and sheet3). Sheet1 is master sheet of sheet2 and sheet3 means it will get data from these 2 sheets, so sheet1 columns are combination of sheet2 & sheet3 columns.

sheet2 & sheet3 are linked with different external sources and when ever changes will occur in external sources automatically these two sheets will get updated . so always these sheets are having latest data .

but sheet1 is getting data from sheet2 and sheet3, sheet1 is not updating every time when sheet3 got update ,since we are not automated the connection between sheet1 and sheet3.

our objective of this Macro is , it should compare the sheet1 and sheet3 based on Request Number(it is a unique and common column in both sheets) and needs to copy the whole row corresponding to the request number from sheet3 which does not exists in sheet1 and paste the data into corresponding columns in sheet1. we need to make sure that no duplicate values are occurred in Request Number in sheet1.( example sheet1 have 10 rows and sheet3 have 13 rows, in both sheets 10 rows are identical and remaining 3 rows added newly in sheet3. now we need to copy those 3 rows into sheet1 into corresponding coulmns)

here i have attached the macro code, it is working fine up to some content but not satisfying my requirement.

Sub TestCompareWorksheets()
' compare two different worksheets in the active workbook
CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")

End Sub

Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim rptWB As Workbook, DiffCount As Long
Application.ScreenUpdating = False
Application.StatusBar = "Creating the report..."
Set rptWB = ActiveWorkbook
Application.DisplayAlerts = False
Application.DisplayAlerts = True
With ws1.UsedRange
lr1 = .Rows.Count
lc1 = .Columns.Count
End With
With ws2.UsedRange
lr2 = .Rows.Count
lc2 = .Columns.Count
End With
maxR = lr1
maxC = lc1
If maxR < lr2 Then maxR = lr2
If maxC < lc2 Then maxC = lc2
DiffCount = 0
For c = 1 To maxC
Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..."
For r = 1 To maxR
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = ws1.Cells(r, c).FormulaLocal
cf2 = ws2.Cells(r, c).FormulaLocal
On Error GoTo 0
If cf1 <> cf2 Then
DiffCount = DiffCount + 1
Cells(r, c).Formula = "'" & cf1 & cf2
End If
Next r
Next c
Application.StatusBar = "Formatting the report..."
With Range(Cells(1, 1), Cells(maxR, maxC))
.Interior.ColorIndex = 19
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
On Error Resume Next
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
On Error GoTo 0
End With
Columns("A:IV").ColumnWidth = 20
rptWB.Saved = True

Set rptWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox DiffCount & " cells contain different formulas!", vbInformation, _
"Compare " & ws1.Name & " with " & ws2.Name
End Sub

Any help would be highly appreciated.

thanks in advance.

Old January 29th, 2012, 12:09 PM
Friend of Wrox
Join Date: Sep 2005
Posts: 812
Thanks: 1
Thanked 53 Times in 49 Posts

Since your Excel file well-formatted and have some unique value (Request Number), can you try using ADO (http://vbadud.blogspot.com/2008/05/u...-database.html). You can play with SQL Query to find the common ones / duplicate ones etc

C# Code Snippets (http://www.dotnetdud.blogspot.com)

VBA Tips &amp; Tricks (http://www.vbadud.blogspot.com)

Similar Threads
Thread Thread Starter Forum Replies Last Post
To copy data from three sheets into one sheet. honey26 Excel VBA 3 June 7th, 2011 07:04 AM
Open Workbook,Copy Sheet,Move Sheet, Close/Save ptrussell2009 Excel VBA 0 June 13th, 2008 02:28 PM
access function in data sheet(another sheet) jani Excel VBA 1 May 21st, 2008 07:15 PM
Copy specific data from one sheet to another yogeshyl Excel VBA 2 May 11th, 2007 09:14 AM
Marcro to copy data from one sheet to another Crupa Excel VBA 1 November 24th, 2004 04:12 AM

Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.