Compare two spreadsheet

S

sub.gnav

Hello every one ,
Am a new bee to Ms excel. Am trying to find way to
compare rows in two different spread sheets lets say spread A and
Spread sheet B . I like to compare row with a key for example taking
teamnumber as Key in two sheets and update data under Jan Feb march
april in spread sheet B and put comments in a file on what was updated
with time stamp.

Spread sheet A.

Id teamname funds jan feb march april
3 greatteam 10 1 2 4 3

Spread Sheet B

Location teamname funds jan feb march april
Dallas greatteam 11 .5 1 2 1

Out put should look like
---------------------------------------------

Spread sheet B
Location teamname funds jan feb march april
Dallas greatteam 10 1 2 4 3

and it would be great if comments or any other form of log file is
creasted with what all are updated. Appreciate the help/input

thanks
 
J

Joel

Try this code. Change MyFolder as required. I used sheet1 and sheet2 as
sheet names. Change as needed.

Sub updateteam()

Const MyFolder = "c:\temp\team.log"
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fs, f, ts, s
Set fs = CreateObject("Scripting.FileSystemObject")

fs.CreateTextFile MyFolder 'Create a file
Set f = fs.GetFile(MyFolder)
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)

With Sheets("Sheet1")
.Activate
LastRowSh1 = Cells(Rows.Count, "B").End(xlUp).Row
Set TeamRange = .Range(.Cells(2, "B"), _
.Cells(LastRowSh1, "B"))

Sheets("Sheet2").Activate
LastRowSh2 = Cells(Rows.Count, "B").End(xlUp).Row
For RowCount = 2 To LastRowSh2

Set c = TeamRange.Find( _
what:=Cells(RowCount, "B"), _
LookIn:=xlValues)
If Not c Is Nothing Then
'compare fund
If Cells(RowCount, "C") <> _
.Cells(RowCount, "C") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed Fund From: " & _
Trim(Str(.Cells(RowCount, "C"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "C")))
ts.writeline msg

Cells(RowCount, "C") = _
.Cells(RowCount, "C")
End If
'compare jan
If Cells(RowCount, "D") <> _
.Cells(RowCount, "D") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed Jan From: " & _
Trim(Str(.Cells(RowCount, "D"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "D")))
ts.writeline msg
Cells(RowCount, "D") = _
.Cells(RowCount, "D")
End If
'compare feb
If Cells(RowCount, "E") <> _
.Cells(RowCount, "E") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed February From: " & _
Trim(Str(.Cells(RowCount, "E"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "E")))
ts.writeline msg
Cells(RowCount, "E") = _
.Cells(RowCount, "E")
End If
'compare march
If Cells(RowCount, "F") <> _
.Cells(RowCount, "F") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed March From: " & _
Trim(Str(.Cells(RowCount, "F"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "F")))
ts.writeline msg
Cells(RowCount, "F") = _
.Cells(RowCount, "F")
End If
'compare april
If Cells(RowCount, "G") <> _
.Cells(RowCount, "G") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed April From: " & _
Trim(Str(.Cells(RowCount, "G"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "G")))
ts.writeline msg
Cells(RowCount, "G") = _
.Cells(RowCount, "G")
End If

Else
msg = "Did not find team " & Cells(RowCount, "B")
ts.writeline msg
MsgBox (msg)
End If
Next RowCount
End With

ts.Close

End Sub
 
S

sub.gnav

Try this code. Change MyFolder as required. I used sheet1 and sheet2 as
sheet names. Change as needed.

Sub updateteam()

Const MyFolder = "c:\temp\team.log"
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fs, f, ts, s
Set fs = CreateObject("Scripting.FileSystemObject")

fs.CreateTextFile MyFolder 'Create a file
Set f = fs.GetFile(MyFolder)
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)

With Sheets("Sheet1")
.Activate
LastRowSh1 = Cells(Rows.Count, "B").End(xlUp).Row
Set TeamRange = .Range(.Cells(2, "B"), _
.Cells(LastRowSh1, "B"))

Sheets("Sheet2").Activate
LastRowSh2 = Cells(Rows.Count, "B").End(xlUp).Row
For RowCount = 2 To LastRowSh2

Set c = TeamRange.Find( _
what:=Cells(RowCount, "B"), _
LookIn:=xlValues)
If Not c Is Nothing Then
'compare fund
If Cells(RowCount, "C") <> _
.Cells(RowCount, "C") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed Fund From: " & _
Trim(Str(.Cells(RowCount, "C"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "C")))
ts.writeline msg

Cells(RowCount, "C") = _
.Cells(RowCount, "C")
End If
'compare jan
If Cells(RowCount, "D") <> _
.Cells(RowCount, "D") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed Jan From: " & _
Trim(Str(.Cells(RowCount, "D"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "D")))
ts.writeline msg
Cells(RowCount, "D") = _
.Cells(RowCount, "D")
End If
'compare feb
If Cells(RowCount, "E") <> _
.Cells(RowCount, "E") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed February From: " & _
Trim(Str(.Cells(RowCount, "E"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "E")))
ts.writeline msg
Cells(RowCount, "E") = _
.Cells(RowCount, "E")
End If
'compare march
If Cells(RowCount, "F") <> _
.Cells(RowCount, "F") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed March From: " & _
Trim(Str(.Cells(RowCount, "F"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "F")))
ts.writeline msg
Cells(RowCount, "F") = _
.Cells(RowCount, "F")
End If
'compare april
If Cells(RowCount, "G") <> _
.Cells(RowCount, "G") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed April From: " & _
Trim(Str(.Cells(RowCount, "G"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "G")))
ts.writeline msg
Cells(RowCount, "G") = _
.Cells(RowCount, "G")
End If

Else
msg = "Did not find team " & Cells(RowCount, "B")
ts.writeline msg
MsgBox (msg)
End If
Next RowCount
End With

ts.Close

End Sub













- Show quoted text -

Thanks Joel ,
This might be a new bee question i get error message
at fs.createtextfile myfolder in

fs.CreateTextFile MyFolder 'Create a file
Set f = fs.GetFile(MyFolder)
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)


routine. Inital guess was may be i should change privilalges on my
folder ...and try that ...that didnt really help should i change any
privillages ?
Appreciate it
 
S

sub.gnav

Thanks Joel ,
This might be a new bee question i get error message
at fs.createtextfile myfolder in

fs.CreateTextFile MyFolder 'Create a file
Set f = fs.GetFile(MyFolder)
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)

routine. Inital guess was may be i should change privilalges on my
folder ...and try that ...that didnt really help should i change any
privillages ?
Appreciate it- Hide quoted text -

- Show quoted text -

error message is runtime error 70 permission denied
 
J

Joel

I made a change to the from RowCount to c.Row in a fedw places to improve the
code.

I tried duplicating the Error 70. If the path name doesn't exist the error
code wuould be Path Not found. The only way I got the 70 error was to make
the file team.log Read Only. Other error I got by illegal names was an error
76 such a leaving out the backslash in the path name c:temp\team.log.

Try making the file team.log with note pad. Open notepad and then save the
file in any location. This is a good test to see if you have the write
permissions. Also try the code in a directory you know that you have write
permission.

It is always best to split problems into pieces. Get the code working, then
worry about putting the file in the place you really want to write the log
file.


Sub updateteam()

Const MyFolder = "c:\temp\team.log"
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fs, f, ts, s
Set fs = CreateObject("Scripting.FileSystemObject")

fs.CreateTextFile MyFolder 'Create a file
Set f = fs.GetFile(MyFolder)
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)

With Sheets("Sheet1")
.Activate
LastRowSh1 = Cells(Rows.Count, "B").End(xlUp).Row
Set TeamRange = .Range(.Cells(2, "B"), _
.Cells(LastRowSh1, "B"))

Sheets("Sheet2").Activate
LastRowSh2 = Cells(Rows.Count, "B").End(xlUp).Row
For RowCount = 2 To LastRowSh2

Set c = TeamRange.Find( _
what:=Cells(RowCount, "B"), _
LookIn:=xlValues)
If Not c Is Nothing Then
'compare fund
If Cells(RowCount, "C") <> _
.Cells(c.Row, "C") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed Fund From: " & _
Trim(Str(.Cells(c.Row, "C"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "C")))
ts.writeline msg

Cells(RowCount, "C") = _
.Cells(c.Row, "C")
End If
'compare jan
If Cells(RowCount, "D") <> _
.Cells(c.Row, "D") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed Jan From: " & _
Trim(Str(.Cells(c.Row, "D"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "D")))
ts.writeline msg
Cells(RowCount, "D") = _
.Cells(c.Row, "D")
End If
'compare feb
If Cells(RowCount, "E") <> _
.Cells(c.Row, "E") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed February From: " & _
Trim(Str(.Cells(c.Row, "E"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "E")))
ts.writeline msg
Cells(RowCount, "E") = _
.Cells(c.Row, "E")
End If
'compare march
If Cells(RowCount, "F") <> _
.Cells(c.Row, "F") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed March From: " & _
Trim(Str(.Cells(c.Row, "F"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "F")))
ts.writeline msg
Cells(RowCount, "F") = _
.Cells(c.Row, "F")
End If
'compare april
If Cells(RowCount, "G") <> _
.Cells(c.Row, "G") Then

msg = Cells(RowCount, "B") & ": " & _
"Changed April From: " & _
Trim(Str(.Cells(c.Row, "G"))) & _
" To: " & _
Trim(Str(Cells(RowCount, "G")))
ts.writeline msg
Cells(RowCount, "G") = _
.Cells(c.Row, "G")
End If

Else
msg = "Did not find team " & Cells(RowCount, "B")
ts.writeline msg
MsgBox (msg)
End If
Next RowCount
End With

ts.Close

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top