Results 1 to 3 of 3
  1. #1
    4 Star Lounger
    Join Date
    Apr 2002
    Location
    Northern Territory, Australia
    Posts
    471
    Thanks
    16
    Thanked 0 Times in 0 Posts

    Unprotect to run macro (Excel 97)

    I want to run this macro while maintaining protection throughout the workbook. What needs to be added to it to unprotect the workbook - run the code - then protect it again?

    Option Explicit

    Sub SortSheets()
    Dim sh As Worksheet
    With Worksheets("Accruals")
    .Range("A5").End(xlToRight).End(xlDown).Sort _
    Key1:=.Range("A4"), Key2:=.Range("B4"), Header:=xlNo, MatchCase:=False
    End With
    SortSheet Worksheets("Apr 03")
    SortSheet Worksheets("May 03")
    SortSheet Worksheets("Jun 03")
    SortSheet Worksheets("Jul 03")
    SortSheet Worksheets("Aug 03")
    SortSheet Worksheets("Sep 03")
    SortSheet Worksheets("Oct 03")
    SortSheet Worksheets("Nov 03")
    SortSheet Worksheets("Dec 03")
    SortSheet Worksheets("Jan 04")
    SortSheet Worksheets("Feb 04")
    SortSheet Worksheets("Mar 04")
    End Sub

    Sub SortSheet(sh As Worksheet)
    Dim rng As Range
    Set rng = sh.Range("A4").End(xlToRight).End(xlDown)
    With rng
    .Sort _
    Key1:=rng.Cells(1, rng.Columns.Count), Order1:=xlDescending, Key2:=rng.Cells(1, rng.Columns.Count - 2), _
    Key3:=rng.Cells(1, 1), Header:=xlYes, MatchCase:=False
    End With
    ColorSheet sh
    End Sub


    Sub ColorSheet(sh As Worksheet)
    Dim lngRow As Long, lngColorIndex As Long
    For lngRow = 5 To sh.Range("AK5").End(xlDown).Row
    Select Case sh.Range("AK" & lngRow).Value
    Case 1
    lngColorIndex = 40
    Case 2
    lngColorIndex = 35
    Case 3
    lngColorIndex = 37
    Case 4
    lngColorIndex = 36
    Case 5
    lngColorIndex = 15
    Case Else
    lngColorIndex = -4142
    End Select
    sh.Range("A" & lngRow & ":B" & lngRow).Interior.ColorIndex = lngColorIndex
    sh.Range("AI" & lngRow & ":AK" & lngRow).Interior.ColorIndex = lngColorIndex
    Next lngRow

    End Sub

    Regards Kerry

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Unprotect to run macro (Excel 97)

    For the Accruals sheet, add two instructions in the main macro:

    With Worksheets("Accruals")
    .Unprotect
    .Range("A5").End(xlToRight).End(xlDown).Sort _
    Key1:=.Range("A4"), Key2:=.Range("B4"), Header:=xlNo, MatchCase:=False
    .Protect
    End With

    For the month sheets, add two lines in SortSheet

    Sub SortSheet(sh As Worksheet)
    Dim rng As Range
    sh.Unprotect
    Set rng = sh.Range("A4").End(xlToRight).End(xlDown)
    With rng
    .Sort _
    Key1:=rng.Cells(1, rng.Columns.Count), Order1:=xlDescending, Key2:=rng.Cells(1, rng.Columns.Count - 2), _
    Key3:=rng.Cells(1, 1), Header:=xlYes, MatchCase:=False
    End With
    ColorSheet sh
    sh.Protect
    End Sub

    If you have protected your sheets with a password, you must add Password:=TopSecret after each Protect and Unprotect, with the actual password substituted for TopSecret. If you have different passwords for each of the sheets, the code will have to be adapted slightly.

  3. #3
    4 Star Lounger
    Join Date
    Apr 2002
    Location
    Northern Territory, Australia
    Posts
    471
    Thanks
    16
    Thanked 0 Times in 0 Posts

    Re: Unprotect to run macro (Excel 97)

    Yup! that works perfectly. Thanks Hans.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •