Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Old May 19th 08, 05:06 PM posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
First recorded activity by ExcelBanter: May 2008
Posts: 4
Default Compare text in 2 separate spreadsheets, when match found display

I'm trying to compare "name" in [sheet1] (where EType.sheet1 = constant), to
name in [sheet2] (where UType.sheet2 equals constant), and write the results
to another sheet.
The "name" in both sheets is a column list of names which may be duplicates,
but only want unique results.
Names only become applicable if EType.sheet1=constant1 and
UType.sheet2=constant2 is true.
Both lists contain blanks and text.
can anyone help and understand me ;-) Needed quite urgently, cheers

  #2   Report Post  
Old May 19th 08, 08:44 PM posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
First recorded activity by ExcelBanter: Dec 2006
Posts: 2,836
Default Compare text in 2 separate spreadsheets, when match found display

I found this Macro on this DG a while back. It works, but it hangs. I
haven't been able to 'fix' it yet...

Sub FindDupes()
Dim sht1 As Worksheet
Dim sht2 As Worksheet

Dim cell1 As Range
Dim cell2 As Range

Dim str As String
str = InputBox("Type name of first sheet")
Set sht1 = Worksheets(str)
str = InputBox("Type name of second sheet")
Set sht2 = Worksheets(str)

For Each cell1 In sht1.Columns(1).Cells
For Each cell2 In sht2.Columns(1).Cells
For Each cell3 In sht3.Columns(1).Cells
If cell2.Value = cell1.Value Then
cell1.Interior.ColorIndex = 5
cell2.Interior.ColorIndex = 3
End If

Next cell2
Next cell1
End Sub



As an alternative, this may do what you want:
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



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




Regards,
Ryan---

--
RyGuy


"cocoblue" wrote:

I'm trying to compare "name" in [sheet1] (where EType.sheet1 = constant), to
name in [sheet2] (where UType.sheet2 equals constant), and write the results
to another sheet.
The "name" in both sheets is a column list of names which may be duplicates,
but only want unique results.
Names only become applicable if EType.sheet1=constant1 and
UType.sheet2=constant2 is true.
Both lists contain blanks and text.
can anyone help and understand me ;-) Needed quite urgently, cheers

  #3   Report Post  
Old May 20th 08, 06:44 PM posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
First recorded activity by ExcelBanter: May 2008
Posts: 4
Default Compare text in 2 separate spreadsheets, when match found disp

Thanks for the sugestions. I was not able to use them this time around.
cheers
Keith

"ryguy7272" wrote:

I found this Macro on this DG a while back. It works, but it hangs. I
haven't been able to 'fix' it yet...

Sub FindDupes()
Dim sht1 As Worksheet
Dim sht2 As Worksheet

Dim cell1 As Range
Dim cell2 As Range

Dim str As String
str = InputBox("Type name of first sheet")
Set sht1 = Worksheets(str)
str = InputBox("Type name of second sheet")
Set sht2 = Worksheets(str)

For Each cell1 In sht1.Columns(1).Cells
For Each cell2 In sht2.Columns(1).Cells
For Each cell3 In sht3.Columns(1).Cells
If cell2.Value = cell1.Value Then
cell1.Interior.ColorIndex = 5
cell2.Interior.ColorIndex = 3
End If

Next cell2
Next cell1
End Sub



As an alternative, this may do what you want:
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



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




Regards,
Ryan---

--
RyGuy


"cocoblue" wrote:

I'm trying to compare "name" in [sheet1] (where EType.sheet1 = constant), to
name in [sheet2] (where UType.sheet2 equals constant), and write the results
to another sheet.
The "name" in both sheets is a column list of names which may be duplicates,
but only want unique results.
Names only become applicable if EType.sheet1=constant1 and
UType.sheet2=constant2 is true.
Both lists contain blanks and text.
can anyone help and understand me ;-) Needed quite urgently, cheers

  #4   Report Post  
Old May 20th 08, 11:57 PM posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
First recorded activity by ExcelBanter: May 2008
Posts: 4
Default Compare text in 2 separate spreadsheets, when match found disp

what i need if you can help is the excel functions to do this;

if row1.col1 isin row1.col2 and ((if row1.col3 = x then highlight row1.col1
with 1) or (if row1.col4 = x then highlight row1.col1 with 2))

this needs to test all text items in col1 against all text items in col2

if you can help

cheers


"cocoblue" wrote:

Thanks for the sugestions. I was not able to use them this time around.
cheers
Keith

"ryguy7272" wrote:

I found this Macro on this DG a while back. It works, but it hangs. I
haven't been able to 'fix' it yet...

Sub FindDupes()
Dim sht1 As Worksheet
Dim sht2 As Worksheet

Dim cell1 As Range
Dim cell2 As Range

Dim str As String
str = InputBox("Type name of first sheet")
Set sht1 = Worksheets(str)
str = InputBox("Type name of second sheet")
Set sht2 = Worksheets(str)

For Each cell1 In sht1.Columns(1).Cells
For Each cell2 In sht2.Columns(1).Cells
For Each cell3 In sht3.Columns(1).Cells
If cell2.Value = cell1.Value Then
cell1.Interior.ColorIndex = 5
cell2.Interior.ColorIndex = 3
End If

Next cell2
Next cell1
End Sub



As an alternative, this may do what you want:
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



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




Regards,
Ryan---

--
RyGuy


"cocoblue" wrote:

I'm trying to compare "name" in [sheet1] (where EType.sheet1 = constant), to
name in [sheet2] (where UType.sheet2 equals constant), and write the results
to another sheet.
The "name" in both sheets is a column list of names which may be duplicates,
but only want unique results.
Names only become applicable if EType.sheet1=constant1 and
UType.sheet2=constant2 is true.
Both lists contain blanks and text.
can anyone help and understand me ;-) Needed quite urgently, cheers



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
combining text from separate excel spreadsheets into one spreadshe Wayne Excel Worksheet Functions 1 January 4th 08 07:24 AM
How to match and compare two spreadsheets Brad Excel Worksheet Functions 1 June 28th 07 09:32 AM
compare & match text Susanne Excel Worksheet Functions 5 May 22nd 07 05:34 PM
Find text in another workbook and paste if found match - VBA Pasmatos Excel Discussion (Misc queries) 1 November 10th 05 02:00 PM
Can I use Excel to match text data from 2 separate columns ? Dan Excel Worksheet Functions 1 September 29th 05 03:51 AM


All times are GMT +1. The time now is 09:26 PM.

Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
Copyright 2004-2021 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Copyright © 2017