VBA Help

Rob_010101

Rob_010101

Board Regular
Joined
Jul 24, 2017
Messages
198
Office Version
  1. 365
Platform
  1. Windows
Hello,

Really silly question but I have no idea how to do this:

I need to add these two:

VBA Code: 
Me.Protect Password:="zzz"

VBA Code: 
Me.Unprotect Password:="zzz"

Into the below, so I can get the below to work on a protected workbook. The ZZZ I will amend to the protection password later but it basically needs to unprotect my workbook, run the code and then reprotect it.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 
  Dim fromRow%
  Dim archiveRow%
  Dim strMatch As String
  Dim wsTarget As Worksheet   'sheet to move data to
  Dim blnMove As Boolean      'whether to move data or not
  Dim blnOnlyValues As Boolean   'determine if it´s the arvjice
 
  If Target.Cells.Count > 1 Then Exit Sub

  If Not Application.Intersect(Target, Range("S2:S1500")) Is Nothing Then 'amend this range address to your
    blnOnlyValues = False
    Select Case UCase(Target.Value)       'as you have given both "closed" and "Closed"
      Case "CLOSED"
        Set wsTarget = ThisWorkbook.Worksheets("Archived Absence")
        blnMove = True
        blnOnlyValues = True
      Case "PHASED RETURN"
        Set wsTarget = ThisWorkbook.Worksheets("Phased Return")
        blnMove = True
        blnOnlyValues = True
      Case "LTS"
        Set wsTarget = ThisWorkbook.Worksheets("Long Term")
        blnMove = True
      Case Else
        blnMove = False
    End Select
    If blnMove Then
       'section of code is taken from your posting
      fromRow = ActiveCell.Row
      With wsTarget     'only change made here
        If .FilterMode Then
          strMatch = "match" & Replace("(2,1/(a:a>""""),1)", "a:a", .AutoFilter.Range.Cells(1).EntireColumn.Address(0, 0, 1, 1))
          archiveRow = Evaluate(strMatch) + 1
        Else
          archiveRow = wsTarget.Cells(wsTarget.Rows.Count, 1).End(3).Row + 1
        End If
      End With
Range(Cells(fromRow, 1), Cells(fromRow, 20)).Copy wsTarget.Cells(archiveRow, 1)
With wsTarget                                                                     '<-- added
    .Range(.Cells(archiveRow, 1), .Cells(archiveRow, 20)).FormatConditions.Delete '<-- added
End With                                                                          '<-- added
If blnOnlyValues Then wsTarget.Cells(archiveRow, 1).Resize(1, 20).Value = Cells(fromRow, 1).Resize(1, 20).Value
Application.EnableEvents = False      '<-- added
Rows(fromRow).EntireRow.Delete
Application.EnableEvents = True       '<-- added
Set wsTarget = Nothing
    End If
  End If

End Sub

Man, I need to learn how to use this properly, so useful!

kind Regards
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Sort by date Sort by votes
TBH, it will be a lot easier to create a constant to hold the password, then you don't need to hunt through looking for it, just change in one place.

VBA Code: 
Const myPass as String = "ZZZ"

Private Sub Worksheet_Change(ByVal Target As Range)
Me.Unprotect myPass
'your code
Me.Protect myPass
End Sub

If you'll be using it elsewhere in your VBA Project then use "Public Const" instead of "Const"
 
Upvote 0
dave3009 said:
TBH, it will be a lot easier to create a constant to hold the password, then you don't need to hunt through looking for it, just change in one place.

VBA Code: 
Const myPass as String = "ZZZ"

Private Sub Worksheet_Change(ByVal Target As Range)
Me.Unprotect myPass
'your code
Me.Protect myPass
End Sub

If you'll be using it elsewhere in your VBA Project then use "Public Const" instead of "Const"
Click to expand...
1665191013305.png
 
Upvote 0
dave3009 said:
TBH, it will be a lot easier to create a constant to hold the password, then you don't need to hunt through looking for it, just change in one place.

VBA Code: 
Const myPass as String = "ZZZ"

Private Sub Worksheet_Change(ByVal Target As Range)
Me.Unprotect myPass
'your code
Me.Protect myPass
End Sub

If you'll be using it elsewhere in your VBA Project then use "Public Const" instead of "Const"
Click to expand...
Also, if I protect the sheet I'm moving the row to, the VB code stops working
 
Upvote 0
Stick the Public Const in a separate standard module, that'll resolve the compile error.

Don't use 'Me' if you are unprotecting a different sheet, use whatever reference you've set for that sheet.

VBA Code: 
wsTarget.Unprotect myPass
'code to do stuff with the other sheet
wsTarget.Protect myPass
 
Upvote 0
Hi Chris (again :)),

Here's my attempt where I created two password variables - one for the sheets and one for the workbook. I also tweaked some of your original code:

VBA Code: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim fromRow As Long 'Changed to long to better accommodate the large nunmber of rows in each tab
    Dim archiveRow As Long 'Changed to long to better accommodate the large nunmber of rows in each tab
    Dim strMatch As String
    Dim wsTarget As Worksheet   'sheet to move data to
    Dim blnMove As Boolean      'whether to move data or not
    Dim blnOnlyValues As Boolean   'determine if it´s the arvjice

    If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Range("S2:S1500")) Is Nothing Then 'amend this range address to your
        ThisWorkbook.Unprotect Password:=WbPass
        Application.ScreenUpdating = False
        blnOnlyValues = False
        Select Case UCase(Target.Value)       'as you have given both "closed" and "Closed"
            Case "CLOSED"
                Set wsTarget = ThisWorkbook.Worksheets("Archived Absence")
                blnMove = True
                blnOnlyValues = True
            Case "PHASED RETURN"
                Set wsTarget = ThisWorkbook.Worksheets("Phased Return")
                blnMove = True
                blnOnlyValues = True
            Case "LTS"
                Set wsTarget = ThisWorkbook.Worksheets("Long Term")
                blnMove = True
            Case Else
                blnMove = False
        End Select
        If blnMove Then
            wsTarget.Unprotect Password:=WsPass
            'section of code is taken from your posting
            fromRow = ActiveCell.Row
            With wsTarget     'only change made here
                If .FilterMode Then
                    strMatch = "match" & Replace("(2,1/(a:a>""""),1)", "a:a", .AutoFilter.Range.Cells(1).EntireColumn.Address(0, 0, 1, 1))
                    archiveRow = Evaluate(strMatch) + 1
                Else
                    archiveRow = wsTarget.Cells(wsTarget.Rows.Count, 1).End(3).Row + 1
                End If
            End With
            Application.EnableEvents = False
            With wsTarget
                Range(Cells(fromRow, 1), Cells(fromRow, 20)).Copy .Cells(archiveRow, 1)
                .Range(.Cells(archiveRow, 1), .Cells(archiveRow, 20)).FormatConditions.Delete
            End With
            If blnOnlyValues Then
                wsTarget.Cells(archiveRow, 1).Resize(1, 20).Value = Cells(fromRow, 1).Resize(1, 20).Value
                Rows(fromRow).EntireRow.Delete
                wsTarget.Protect Password:=WsPass
                Set wsTarget = Nothing
            End If
            Application.EnableEvents = True
        End If
        ThisWorkbook.Protect Password:=WbPass
        Application.ScreenUpdating = True
    End If

End Sub

Regards,

Robert
 
Upvote 0
Trebor76 said:
Hi Chris (again :)),

Here's my attempt where I created two password variables - one for the sheets and one for the workbook. I also tweaked some of your original code:

VBA Code: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim fromRow As Long 'Changed to long to better accommodate the large nunmber of rows in each tab
    Dim archiveRow As Long 'Changed to long to better accommodate the large nunmber of rows in each tab
    Dim strMatch As String
    Dim wsTarget As Worksheet   'sheet to move data to
    Dim blnMove As Boolean      'whether to move data or not
    Dim blnOnlyValues As Boolean   'determine if it´s the arvjice

    If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Range("S2:S1500")) Is Nothing Then 'amend this range address to your
        ThisWorkbook.Unprotect Password:=WbPass
        Application.ScreenUpdating = False
        blnOnlyValues = False
        Select Case UCase(Target.Value)       'as you have given both "closed" and "Closed"
            Case "CLOSED"
                Set wsTarget = ThisWorkbook.Worksheets("Archived Absence")
                blnMove = True
                blnOnlyValues = True
            Case "PHASED RETURN"
                Set wsTarget = ThisWorkbook.Worksheets("Phased Return")
                blnMove = True
                blnOnlyValues = True
            Case "LTS"
                Set wsTarget = ThisWorkbook.Worksheets("Long Term")
                blnMove = True
            Case Else
                blnMove = False
        End Select
        If blnMove Then
            wsTarget.Unprotect Password:=WsPass
            'section of code is taken from your posting
            fromRow = ActiveCell.Row
            With wsTarget     'only change made here
                If .FilterMode Then
                    strMatch = "match" & Replace("(2,1/(a:a>""""),1)", "a:a", .AutoFilter.Range.Cells(1).EntireColumn.Address(0, 0, 1, 1))
                    archiveRow = Evaluate(strMatch) + 1
                Else
                    archiveRow = wsTarget.Cells(wsTarget.Rows.Count, 1).End(3).Row + 1
                End If
            End With
            Application.EnableEvents = False
            With wsTarget
                Range(Cells(fromRow, 1), Cells(fromRow, 20)).Copy .Cells(archiveRow, 1)
                .Range(.Cells(archiveRow, 1), .Cells(archiveRow, 20)).FormatConditions.Delete
            End With
            If blnOnlyValues Then
                wsTarget.Cells(archiveRow, 1).Resize(1, 20).Value = Cells(fromRow, 1).Resize(1, 20).Value
                Rows(fromRow).EntireRow.Delete
                wsTarget.Protect Password:=WsPass
                Set wsTarget = Nothing
            End If
            Application.EnableEvents = True
        End If
        ThisWorkbook.Protect Password:=WbPass
        Application.ScreenUpdating = True
    End If

End Sub

Regards,

Robert
Click to expand...
Hi Again Robert :)

This seems to work, except it now doesn't delete the row from the original sheet once moved across?

Regards
Chris
 
Upvote 0
It could be this line...

VBA Code: 
fromRow = ActiveCell.Row

...because the active cell is now one row beneath where the entry that originally fired up the code resides i.e. if Closed was entered in cell S2 the active row is probably now 3.

Put a breakpoint on that line and when the code stops there hover over it to see what value is being returned.
 
Upvote 0
Rollis13 on a question I asked on the thread: VBA Clear Conditional Format

Commented the below, regarding the same query with fromRow = ActiveCell.Row

No idea on what your project goal is but if you are moving a row to a different destination then I would delete the 'target' row (source). With fromRow = ActiveCell.Row you will select the row below the target.
Got it !!! It's ok because you are using Validation dropdown that doesn't change cell when item is choosen. I, instead, was testing with manual change to cells in column R and that would change cell focus.
Click to expand...

Regards
 
Upvote 0
You must log in or register to reply here.

Similar threads

Rob_010101
  • Solved
Add message box
Replies
4
Views
503
Joe4
Joe4
Rob_010101
  • Solved
Error 1004
Replies
3
Views
407
Domenic
D
Rob_010101
  • Solved
VBA Small Amendment
Replies
3
Views
578
mohadin
M
Rob_010101
  • Solved
VBA Clear Conditional Format
Replies
7
Views
1K
Rob_010101
Rob_010101
Rob_010101
  • Solved
Paste Values in VBA
Replies
7
Views
696
MARK858
MARK858

Forum statistics

Threads
1,224,813
Messages
6,181,117
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top