PDA

View Full Version : [SOLVED] VBA codes clashing



Juriemagic
04-12-2016, 02:20 AM
Hi good people!,

This is a problem I am sooo tired of struggling with, please help me with this:

This code:

Private Sub Worksheet_Activate()
Dim WS As Worksheet

For Each WS In ThisWorkbook.Worksheets
If WS.Name <> ActiveSheet.Name Then WS.Visible = xlSheetVeryHidden
Next WS
Sheets("LOG").Unprotect
Range("LOG").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveWindow.SmallScroll toleft:=10
Application.DisplayFormulaBar = False
ActiveWindow.DisplayWorkbookTabs = False
ActiveWindow.DisplayHeadings = False
Range("C4").Select
Sheets("LOG").Protect
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Sheets("LOG").Unprotect
Dim rCell As Range
Dim rChange As Range

Set rChange = Intersect(Target, Range("C:C"))
If Not rChange Is Nothing Then
Application.EnableEvents = False
For Each rCell In rChange
If rCell > "" Then
rCell.Offset(0, 1).Value = Environ$("UserName")
rCell.Offset(0, 2).Value = Now

Else
'do nothing
End If
Next
End If

ExitHandler:
Set rCell = Nothing
Set rChange = Nothing
Application.EnableEvents = True
Sheets("LOG").Protect
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
Private Sub Worksheet_Deactivate()
Sheets("LOG").Unprotect
End Sub

Private Sub Worksheet_Activate()
Dim WS As Worksheet

For Each WS In ThisWorkbook.Worksheets
If WS.Name <> ActiveSheet.Name Then WS.Visible = xlSheetVeryHidden
Next WS
Sheets("LOG").Unprotect
Range("LOG").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveWindow.SmallScroll toleft:=10
Application.DisplayFormulaBar = False
ActiveWindow.DisplayWorkbookTabs = False
ActiveWindow.DisplayHeadings = False
Range("C4").Select
Sheets("LOG").Protect
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Sheets("LOG").Unprotect
Dim rCell As Range
Dim rChange As Range

Set rChange = Intersect(Target, Range("C:C"))
If Not rChange Is Nothing Then
Application.EnableEvents = False
For Each rCell In rChange
If rCell > "" Then
rCell.Offset(0, 1).Value = Environ$("UserName")
rCell.Offset(0, 2).Value = Now

Else
'do nothing
End If
Next
End If

ExitHandler:
Set rCell = Nothing
Set rChange = Nothing
Application.EnableEvents = True
Sheets("LOG").Protect
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
Private Sub Worksheet_Deactivate()
Sheets("LOG").Unprotect
End Sub



The above code resides in the LOG sheet.

Then I have this code which resides in a BUTTON on the UPDATE ROOM sheet:

Sub LogChanges()
'
' LogChanges Macro
'

'
If ActiveSheet.Range("A100").Value = 1 Then Exit Sub
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
On Error GoTo a:

Set copySheet = Worksheets("Update Room")
Set pasteSheet = Worksheets("LOG")
copySheet.Unprotect
copySheet.Range("E3").Copy
With pasteSheet
.Unprotect
.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Range("C4:E1004").Select
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("E4:E1004"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
With pasteSheet.Sort
.SetRange Range("C4:E1004")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
copySheet.Select
copySheet.Unprotect
Range("A100").Value = 1
ActiveSheet.Shapes.Range(Array("Button 23")).Visible = False
Range("E3:F3").Locked = False
Range("C3:D3").Locked = False
pasteSheet.Activate

Range("A1").Select
copySheet.Protect
pasteSheet.Protect

a:

Exit Sub


End Sub


When certain changes are made to the UPDATE ROOM sheet, button 23 becomes visible. On clicking this button, the code executes to copy and paste to the LOG sheet. What happens is that I get "Error 1004, Select method.....". When debugging I see the LOG code with yellow highlight on
Range("LOG").Select.

NOW, there is another button on the UPDATE ROOM sheet which has the caption "LOG". This is just a normal navigation button to make the LOG sheet visible and xlveryhidden the UPDATE ROOM sheet. When navigating like this, no errors come up. The error ONLY comes up when I need to UPDATE the LOG sheet, using the "Log Changes" macro.

All and any help will be accepted with great humility and admiration, Thank you all very much!

Bob Phillips
04-12-2016, 04:41 AM
A copy of the workbook would help, so we could see it in action.

Juriemagic
04-12-2016, 06:18 AM
Hi xld,

Thy wb size is 27M, it wouldn't go through. I have spent some time in the meantime studying vba and realized what the problem might be. Which is: The UPDATE ROOM sheet stays active, so, when the code runs and gets to the part where it calls the LOG sheet, the code searches for the range (LOG), and does not find it because it tries to find it on the active sheet...I am still very far from cracking this, but hopefully if you could try and see from the codes I sent, and the two of us together try, we just might beat this thing?

SamT
04-12-2016, 06:20 AM
Use Application.EnableEvents.

Don't use "ActiveSheet" or Select statements.

Juriemagic
04-12-2016, 06:32 AM
Hi SamT,

I fully agree, have actually just read on that...I'm busy changing codes to "with" statements. thanx for your help, I really do appreciate..

Juriemagic
04-12-2016, 06:54 AM
SamT and xld,

I am thinking to cut this code
.Range("C4:E1004").Select
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("E4:E1004"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
With pasteSheet.Sort
.SetRange Range("C4:E1004")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With


and add it to this code:
Set rChange = Intersect(Target, Range("C:C"))
If Not rChange Is Nothing Then
Application.EnableEvents = False
For Each rCell In rChange
If rCell > "" Then
rCell.Offset(0, 1).Value = Environ$("UserName")
rCell.Offset(0, 2).Value = Now


I'm thinking that just MAYBE it will be better to have each sheet perform it's own duties, so the macro copies and inserts onto the LOG sheet, which in turn adds the "user" and "date-time", and then it should just go one step further and that is to sort the columns. I have tried adding this piece but nothing happens. Could you guys please be so kind to show me how to successfully add this?

Juriemagic
04-12-2016, 07:23 AM
Hi guys,

I cracked it! Thank you anyways for being out there..