Excel help

davemc

Hi guys...

I'm wondering if someone can help me out here with an Excel problem. The situation is as follows: I have an Excel spreadsheel with 2 tabs/worksheets...there are hundreds of rows of data in each worksheet.....in column 'E' there is a 4-digit number in each of the worksheets.....What I want is for Excel to take Column 'E' in the first spreadsheet and compare against column 'E' in the second worksheet...If it finds an identical 4-digit number in the second worksheet then ignore the data but if it fails to find an identical number in the second worksheet then I want Excel to copy the full row of data in the first worksheet and paste it into the 3rd worksheet!!.....easy??......I don't claim to be an Excel guru but could sure do with a helping hand in this by someone.....cheers..Dave.

Jaden

Access could do this.

So could OpenOffice, using the "Data Sources" menu.

If you have either of these installed, post back, and we'll look at it again.

davemc

Jaden.....

unfortunately I'm working only through Excel on this as data is constantly being added on a daily basis from other spreadsheets.....any ideas?

amen

heres a little macro that should do what you want. it needs some tidying up though

Sub CompareSheets()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim lRW1 As Long
Dim lRW2 As Long
Dim lOuterCount As Long
Dim lInnerCount As Long
Dim CR1
Dim CR2
Dim bMatchFound As Boolean
'ref worksheets
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
'set the current regions
CR1 = ws1.Range("E1").CurrentRegion
CR2 = ws2.Range("E1").CurrentRegion
'get row counts
RW1 = ws1.Range("E1").CurrentRegion.Rows.Count
RW2 = ws2.Range("E1").CurrentRegion.Rows.Count
MsgBox RW1
For lOuterCount = 1 To RW1
bMatchFound = False
For lInnerCount = 1 To RW2
If CR1(lOuterCount, 2) = CR2(lInnerCount, 2) Then
bMatchFound = True
End If
Next 'lInnerCount
If Not bMatchFound Then
ws3.Cells(lOuterCount, 2) = CR1(lOuterCount, 2)
End If
Next 'lOuterCount

End Sub

Seth Brundle

I found this but it only compares cell against cell rather than cell against column.
I'll find a soln for you

---

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 = Workbooks.Add
Application.DisplayAlerts = False
While Worksheets.Count > 1
Worksheets(2).Delete
Wend
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
If DiffCount = 0 Then
rptWB.Close False
End If
Set rptWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox DiffCount & " cells contain different formulas!", vbInformation, _
"Compare " & ws1.Name & " with " & ws2.Name
End Sub

'This example macro shows how to use the macro above:
Sub TestCompareWorksheets()
' compare two different worksheets in the active workbook
CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
' compare two different worksheets in two different workbooks
CompareWorksheets ActiveWorkbook.Worksheets("Sheet1"), _
Workbooks("WorkBookName.xls").Worksheets("Sheet2")
End Sub

Seth Brundle

I have now found this piece of code but it only returns the unique values in cells in Sheet1 column E but not the whole row.
Anyone else???

---

Sub RunMe()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim cll As Range

Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")

Set rng1 = sht1.Range(sht1.Cells(1, 5), sht1.Cells(65536, 5).End(xlUp))
Set rng2 = sht2.Range(sht2.Cells(1, 5), sht2.Cells(65536, 5).End(xlUp))

For Each cll In rng1.Cells
If rng2.Find(cll.Value, LookAt:=xlWhole) Is Nothing Then
Worksheets("Sheet3").Cells(65536, 5).End(xlUp).Offset(1).Value = cll.Value
End If
Next cll
End Sub

davemc

Bloody hell!!!!!.......I've come to the realisation that I'm totally crap at Excel!!!!........Amen....thanks for hand out ....KBannon....My head exploded just reading what you posted!!.....what exactly was it!!?.....many thanks to all whom contributed thus far......

Seth Brundle

its VBA - Visual Basic for Applications
www.the-excel-advisor.com/excel-macros-vba-tutorial.html