LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2
Default Compare 2 excel sheets -Error Checking of entered names

Can anyone assist with an error check here
this allows the user to enter 2 sheet names
and compare them with output of differences in a 3rd
workbook.
I added the go to that is commented out in line 6(below) but it always goes to that go to ..
also there is a limitation as to the columns/rows compared and I cant figure out what that is.
I created this from a few other snippets of code online.
I am doing my best to teach myself :-)

Thanks so much!!

Private Sub CommandButton1_Click()

Dim SHEET1 As String

SHEET1 = InputBox("Enter Sheet Name")
Dim SHEET2 As String

SHEET2 = InputBox("Enter Another Sheet Name")

'On Error GoTo invalid

'invalid:
'MsgBox "One or both sheet names entered are invalid. Please re-enter."
'Exit Sub

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 = 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 data!", vbInformation, _
"Compare " & ws1.Name & " with " & ws2.Name



End Sub






 
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
How do i compare and remove common names from 2 excel work sheets Andrew Excel Worksheet Functions 0 April 8th 10 09:02 AM
Excel compare names chesjak Excel Worksheet Functions 4 October 27th 08 08:48 AM
Compare Two Sheets Generates Runtime Error 13 ryguy7272 Excel Programming 2 October 26th 07 06:04 PM
Checking names on correct line across sheets Ali Excel Worksheet Functions 5 January 17th 06 07:24 AM
How do I compare two lists of names in excel? Jack the Cate Excel Discussion (Misc queries) 1 December 24th 04 12:07 PM


All times are GMT +1. The time now is 07:10 AM.

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

About Us

"It's about Microsoft Excel"