PDA

View Full Version : Working sync update code - need to add some help logging changes made



markpem
06-09-2015, 01:12 AM
Hello

I have some code below which works beautifully, by searching both worksheets and finding a matching reference number in Column A then copying all the non-blank data over from newdata to mainpage to make sure its up to date.

However, I would like a third sheet called LOGS (or similar) which would write what changes were made *IF* they are not the same in that cell (as it just copies all nonblank data). so some code like

If code from mainpage <> code from newdata then write to log: "Ref 12345k Changed from 'Pending' (<-- This would be the data in Mainpage) To 'Completed (<--This would be the data in Newdata)'"

Any help from some awesome experts out there?



Dim s1rw As Long, s2rw As Long, col As Long, endcol As Long
Cancel = True ' Ignore error messages as first column is LOCKED
Sheets("MainPage").Select
With Sheets("NewData")
s2rw = 2 ' Adjust to first data row #
endcol = .Cells(s2rw - 1, 1).End(xlToRight).Column
Do Until .Cells(s2rw, 1).Value = "" ' Loop through case #s
s1rw = 0
On Error Resume Next
s1rw = Cells.Find(What:=.Cells(s2rw, 1).Value, LookIn:=xlFormulas, LookAt:=xlWhole).Row
On Error GoTo 0
If s1rw > 0 Then ' Found case #
For col = 2 To endcol ' Loop through columns
If Cells(s1rw, col).Value <> "" Then
If IsDate(Cells(s1rw, col).Value) Then
.Cells(s2rw, col).Value = Format(Cells(s1rw, col).Value, "mm/dd/yyyy")
Else
.Cells(s2rw, col).Value = Cells(s1rw, col).Value
End If
End If
Next
End If
s2rw = s2rw + 1
Loop
.Select
End With

SamT
06-09-2015, 03:10 AM
Option Explicit

Sub YourCode()
Dim s1rw As Long, s2rw As Long, Col As Long, endcol As Long
Dim LogRw As Long '<<<
LogRw = Sheets("Log").Cell(Rows.Count, 1).End(xUp).Row + 1
Cancel = True ' Ignore error messages as first column is LOCKED
Sheets("MainPage").Select
With Sheets("NewData")
s2rw = 2 ' Adjust to first data row #
endcol = .Cells(s2rw - 1, 1).End(xlToRight).Column
Do Until .Cells(s2rw, 1).Value = "" ' Loop through case #s
s1rw = 0
On Error Resume Next
s1rw = Cells.Find(What:=.Cells(s2rw, 1).Value, LookIn:=xlFormulas, LookAt:=xlWhole).Row
On Error GoTo 0
If s1rw > 0 Then ' Found case #
For Col = 2 To endcol ' Loop through columns
If Cells(s1rw, Col).Value <> "" Then
If IsDate(Cells(s1rw, Col).Value) Then
LogOld .Cells(s2rw, Col) '<<<<<<
.Cells(s2rw, Col).Value = Format(Cells(s1rw, Col).Value, "mm/dd/yyyy")
LogNew .Cells(s2rw, Col) '<<<<<<
Else
LogOld .Cells(s2rw, Col) '<<<<<<<
.Cells(s2rw, Col).Value = Cells(s1rw, Col).Value
LogOnew .Cells(s2rw, Col) '<<<<<<<<
End If
End If
Next
End If
s2rw = s2rw + 1
Loop
.Select
End With
End Sub

Private Sub LogOld(Cel As Range)
Dim LogRw As Long
With Sheets("LOG")
LogRw = .Cells(Rows.Count, 1).End(xUp).Row + 1 '<<<
.Cells(LogRw, 1).Value = Now
.Cells(LogRw, 2).Value = Cel.Address
.Cells(LogRw, 3).Value = Cel.Value
End With
End Sub

Private Sub LogNew(Cel As Range)
Dim LogRw As Long
With Sheets("LOG")
LogRw = .Cells(Rows.Count, 1).End(xUp).Row '<<<
.Cells(LogRw, 4).Value = Cel.Value
End With
End Sub

markpem
06-09-2015, 05:20 AM
Hello SamT

Well first off, thankyou for taking the time to look over my code and help out, you have certainly done quite a bit!

I have run into a little problem which stops the sub on this piece of code:-



LogOld .Cells(s2rw, Col)


Which trips as:- Compile error: Sub of Function not defined

Now normally if I am not mistaken this is usually do to a sub being misspelt
however these are my subs:-



Private Sub LogOld(Cel As Range)
Dim LogRw As Long
With Sheets("LOG")
LogRw = .Cells(Rows.Count, 1).End(xUp).Row + 1 '<<<
.Cells(LogRw, 1).Value = Now
.Cells(LogRw, 2).Value = Cel.Address
.Cells(LogRw, 3).Value = Cel.Value
End With
End Sub

Private Sub LogNew(Cel As Range)
Dim LogRw As Long
With Sheets("LOG")
LogRw = .Cells(Rows.Count, 1).End(xUp).Row '<<<
.Cells(LogRw, 4).Value = Cel.Value
End With
End Sub

SamT
06-09-2015, 09:57 AM
Hmmm. I put them in the same module as the testing sub and they ran OK but only After I fixed the Typo in the "End(xlUp)" In both subs.

Sub not defined error can also mean Sub Not found. Where did you put the Log subs compared to the Changer sub. Usually anything Declared Private has to be in the same code module as what calls it.

Delete the Private declarations, or move them?

If you use the Logs sub on more than one sheet, consider this line

.Cells(LogRw, 2).Value = Cel.Parent.Name & "!" & Cel.Address