Format borders partially not working - corruption ?

Nyanko

Active Member
Joined
Sep 1, 2005
Messages
437
I have a very specific problem with a .xls sheet running on Excel 2010

I'm running a macro that changes the colour of cells and changing the location of a thicker border outline. Nothing extravagent or contraversial !!! However twice now on re-opening the file I have got a "Run Time 1004 : Unable to set the LineStyle propery of the border class" when it has run just perfectly a moment before. On further investigation it appears as if I have lost the right-click format cells option and am unable to format borders for a specific group of cells. ?!

Is this a (very specific) corruption of the file due to the 97/2010 file formats ? I have double checked my coding and apart from some ScreenUpdating I can see nothing else that would affect the running of the sheet.

Please help !!
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Hi,
The code I've posted below, whilst not that elegant, has been working fine.

Its the first section to update the borders that it gets stuck on, yet I know that it works. I have a feeling its the 97/10 thing but our client only has 97 and we only have 10. Sigh

Code:
Option Explicit

'Traffic Light Colours
'Const NoDataColour As Long = &HCCCCCC
Const ZeroValueColour As Long = &HFFFFFF
Const Band01Colour As Long = &HD2FFCD
Const Band02Colour As Long = &HAAFFA0
Const Band03Colour As Long = &H6EFF64
Const Band04Colour As Long = &H3CFFA0
Const Band05Colour As Long = &H2DFFC8
Const Band06Colour As Long = &H1EFFFF
Const Band07Colour As Long = &HFDCFF
Const Band08Colour As Long = &H1AAFF
Const Band09Colour As Long = &H78FF
Const Band10Colour As Long = &HFF

'Alternative Colours
'Const NoDataColour As Long = &HCCCCCC
Const AltZeroColour As Long = &HFFFFFF
Const Alt01Colour As Long = &HF2F2F2
Const Alt02Colour As Long = &HD9D9D9
Const Alt03Colour As Long = &HCCCCCC
Const Alt04Colour As Long = &HBFBFBF
Const Alt05Colour As Long = &HB3B3B3
Const Alt06Colour As Long = &H999999
Const Alt07Colour As Long = &H737373
Const Alt08Colour As Long = &H4F4F4F
Const Alt09Colour As Long = &H262626
Const Alt10Colour As Long = &H0

Sub Recalculate()

    Dim iRow, iCol As Long
    Dim iCustomRow, iCustomCol As Long
    Dim iR, iC As Long
    Dim OpenCol, CloseCol As Long
    Dim sglMin, sglMax, sglAlarm As Single
    Dim TimeOpen, TimeClose As String
    Dim colour As Long
    Dim tRange As String
    Dim numberFormat As String
    
    Set xCustom = Sheets("Custom")
    Set xData = Sheets("Calcs_E")
    xFlag = Range("BE25")
        
    SetLegendColours
    
   'establish max, min & alarm points
    sglMax = xCustom.Cells(21, 57)
    sglMin = xCustom.Cells(22, 57)
    sglAlarm = xCustom.Cells(24, 57)
    
   'Set Start and Close time for off peak calc
    TimeOpen = CStr(Range("BE3"))
    TimeClose = CStr(Range("BF3"))
        
'Clear and redraw borders for Opening/Closing time
Application.ScreenUpdating = False
    Range("C7:AX41").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

    Range("BJ9:BJ56").Select
    Selection.Find(What:=TimeOpen, After:=ActiveCell, SearchOrder:=xlByRows, SearchDirection:=xlNext).Select
    OpenCol = ActiveCell.Offset(0, 1).Value
    Range("BJ9:BJ56").Select
    Selection.Find(What:=TimeClose, After:=ActiveCell, SearchOrder:=xlByRows, SearchDirection:=xlNext).Select
    CloseCol = ActiveCell.Offset(0, 1).Value
    
    Range(Cells(7, OpenCol), Cells(41, CloseCol)).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
Application.ScreenUpdating = True

    ' determine the number of decimal places to show for the bands
    Select Case True
      Case (sglMax < 1)
        numberFormat = "########0.00"
      Case (sglMax < 10)
        numberFormat = "########0.0"
      Case Else
        numberFormat = "########0"
    End Select
    ' format values in the Legend
    Application.Goto Reference:="LegendValuesE"
    Selection.numberFormat = numberFormat
   
   'Clear previous colours and any values
    Range("C9:AX39").Select
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
    Selection.ClearContents
    Range("C56:AX86").Select
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
    Selection.ClearContents

    Application.Goto Reference:="R2C2"
   
   'start row on data (Calcs_E) sheet
    iRow = 12: iCol = 5

    Dim Peak As String
    Dim PeakFlag As Boolean
        
    For iCustomRow = 9 To 39
      iCustomCol = 3 'Start column for colour map
      For iC = 1 To 48 'total rows for colour map
        If xCustom.Cells(6, iCustomCol) = "T" Then
            PeakFlag = True
        Else
            PeakFlag = False
        End If
        Select Case xData.Cells(iRow, iCol)
          Case Is <= 0
            If xFlag <> True Then colour = ZeroValueColour Else colour = AltZeroColour
          Case Is < xCustom.Cells(9, 57)
            If xFlag <> True Then colour = Band01Colour Else colour = Alt01Colour
          Case Is < xCustom.Cells(10, 57)
            If xFlag <> True Then colour = Band02Colour Else colour = Alt02Colour
          Case Is < xCustom.Cells(11, 57)
            If xFlag <> True Then colour = Band03Colour Else colour = Alt03Colour
          Case Is < xCustom.Cells(12, 57)
            If xFlag <> True Then colour = Band04Colour Else colour = Alt04Colour
          Case Is < xCustom.Cells(13, 57)
            If xFlag <> True Then colour = Band05Colour Else colour = Alt05Colour
          Case Is < xCustom.Cells(14, 57)
            If xFlag <> True Then colour = Band06Colour Else colour = Alt06Colour
          Case Is < xCustom.Cells(15, 57)
            If xFlag <> True Then colour = Band07Colour Else colour = Alt07Colour
          Case Is < xCustom.Cells(16, 57)
            If xFlag <> True Then colour = Band08Colour Else colour = Alt08Colour
          Case Is < xCustom.Cells(17, 57)
            If xFlag <> True Then colour = Band09Colour Else colour = Alt09Colour
          Case Else
            If xFlag <> True Then colour = Band10Colour Else colour = Alt10Colour
        End Select
        'Apply colour to cell
        xCustom.Cells(iCustomRow, iCustomCol).Interior.Color = colour
        'if the value is greater that the alarm AND the Peak flag is true then shade to denote exessive use
        If xData.Cells(iRow, iCol) > sglAlarm And PeakFlag = True Then xCustom.Cells(iCustomRow, iCustomCol).Interior.Pattern = xlLightUp
               
        'If xData.Cells(iRow, iCol) = sglMin Then xCustom.Cells(iCustomRow, iCustomCol) = "m" 'Minimum
        If xData.Cells(iRow, iCol) = sglMax Then xCustom.Cells(iCustomRow, iCustomCol) = "M" 'Maximum
        
        iRow = iRow + 1
        iCustomCol = iCustomCol + 1
      Next iC
      'Determines if this is the end of a row
      If iCustomRow > 11 And Day(xCustom.Cells(iCustomRow, 2) + 1) = 1 Then Exit For
    Next iCustomRow
     
'----------------------------------------
'Working on Gas calculations
'----------------------------------------
    Set xData = Sheets("Calcs_GO")
    Set xCustom = Sheets("Custom")
    
    SetLegendColours
    
   'establish max and min points
    sglMax = xCustom.Cells(68, 57)
    sglMin = xCustom.Cells(69, 57)
    sglAlarm = xCustom.Cells(69, 71)
    
    'Clear and redraw borders for Opening/Closing time
Application.ScreenUpdating = False
    Range("C54:AX88").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    
    'As we have already esatblished the Opening & Coloing columns, just update
    Range(Cells(54, OpenCol), Cells(88, CloseCol)).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
Application.ScreenUpdating = True
            
            
    ' determine the number of decimal places to show for the bands
    Select Case True
      Case (sglMax < 1)
        numberFormat = "########0.00"
      Case (sglMax < 10)
        numberFormat = "########0.0"
      Case Else
        numberFormat = "########0"
    End Select
    ' format values in the Legend
    Application.Goto Reference:="LegendValuesG"
    Selection.numberFormat = numberFormat
    Application.Goto Reference:="R2C2"
   
   'start row on data sheet
    iRow = 12: iCol = 5
    
    ActiveWindow.ScrollRow = 47
    Range("B47:BF47").Select
    For iCustomRow = 56 To 86
      iCustomCol = 3
      For iC = 1 To 48
        If xCustom.Cells(6, iCustomCol) = "T" Then
            PeakFlag = True
        Else
            PeakFlag = False
        End If
      
        Select Case xData.Cells(iRow, iCol)
          Case Is <= 0
            If xFlag <> True Then colour = ZeroValueColour Else colour = AltZeroColour
          Case Is < xCustom.Cells(56, 57)
            If xFlag <> True Then colour = Band01Colour Else colour = Alt01Colour
          Case Is < xCustom.Cells(57, 57)
            If xFlag <> True Then colour = Band02Colour Else colour = Alt02Colour
          Case Is < xCustom.Cells(58, 57)
            If xFlag <> True Then colour = Band03Colour Else colour = Alt03Colour
          Case Is < xCustom.Cells(59, 57)
            If xFlag <> True Then colour = Band04Colour Else colour = Alt04Colour
          Case Is < xCustom.Cells(60, 57)
            If xFlag <> True Then colour = Band05Colour Else colour = Alt05Colour
          Case Is < xCustom.Cells(61, 57)
            If xFlag <> True Then colour = Band06Colour Else colour = Alt06Colour
          Case Is < xCustom.Cells(62, 57)
            If xFlag <> True Then colour = Band07Colour Else colour = Alt07Colour
          Case Is < xCustom.Cells(63, 57)
            If xFlag <> True Then colour = Band08Colour Else colour = Alt08Colour
          Case Is < xCustom.Cells(64, 57)
            If xFlag <> True Then colour = Band09Colour Else colour = Alt09Colour
          Case Else
            If xFlag <> True Then colour = Band10Colour Else colour = Alt10Colour
        End Select
        'Apply colour to cell
        xCustom.Cells(iCustomRow, iCustomCol).Interior.Color = colour
        
        'if the value is greater that the alarm AND the Peak flag is true then shade to denote exessive use
        If xData.Cells(iRow, iCol) > sglAlarm And PeakFlag = True Then xCustom.Cells(iCustomRow, iCustomCol).Interior.Pattern = xlLightUp

        'If xData.Cells(iRow, iCol) = sglMin Then xCustom.Cells(iCustomRow, iCustomCol) = "m" 'Minimum
        If xData.Cells(iRow, iCol) = sglMax Then xCustom.Cells(iCustomRow, iCustomCol) = "M" 'Maximum
        
        iRow = iRow + 1
        iCustomCol = iCustomCol + 1
      Next iC
      If iCustomRow > 11 And Day(xCustom.Cells(iCustomRow, 2) + 1) = 1 Then Exit For
    Next iCustomRow
    
    Application.Goto Reference:="R2C2"
    Application.ScreenUpdating = True

End Sub

Private Sub SetLegendColours()
    
    Select Case xFlag
        Case False
        xCustom.Cells(9, 56).Interior.Color = ZeroValueColour
        xCustom.Cells(10, 56).Interior.Color = Band01Colour
        xCustom.Cells(11, 56).Interior.Color = Band02Colour
        xCustom.Cells(12, 56).Interior.Color = Band03Colour
        xCustom.Cells(13, 56).Interior.Color = Band04Colour
        xCustom.Cells(14, 56).Interior.Color = Band05Colour
        xCustom.Cells(15, 56).Interior.Color = Band06Colour
        xCustom.Cells(16, 56).Interior.Color = Band07Colour
        xCustom.Cells(17, 56).Interior.Color = Band08Colour
        xCustom.Cells(18, 56).Interior.Color = Band09Colour
        xCustom.Cells(19, 56).Interior.Color = Band10Colour
        
        xCustom.Cells(56, 56).Interior.Color = ZeroValueColour
        xCustom.Cells(57, 56).Interior.Color = Band01Colour
        xCustom.Cells(58, 56).Interior.Color = Band02Colour
        xCustom.Cells(59, 56).Interior.Color = Band03Colour
        xCustom.Cells(60, 56).Interior.Color = Band04Colour
        xCustom.Cells(61, 56).Interior.Color = Band05Colour
        xCustom.Cells(62, 56).Interior.Color = Band06Colour
        xCustom.Cells(63, 56).Interior.Color = Band07Colour
        xCustom.Cells(64, 56).Interior.Color = Band08Colour
        xCustom.Cells(65, 56).Interior.Color = Band09Colour
        xCustom.Cells(66, 56).Interior.Color = Band10Colour
        
        Case True
        xCustom.Cells(9, 56).Interior.Color = AltZeroColour
        xCustom.Cells(10, 56).Interior.Color = Alt01Colour
        xCustom.Cells(11, 56).Interior.Color = Alt02Colour
        xCustom.Cells(12, 56).Interior.Color = Alt03Colour
        xCustom.Cells(13, 56).Interior.Color = Alt04Colour
        xCustom.Cells(14, 56).Interior.Color = Alt05Colour
        xCustom.Cells(15, 56).Interior.Color = Alt06Colour
        xCustom.Cells(16, 56).Interior.Color = Alt07Colour
        xCustom.Cells(17, 56).Interior.Color = Alt08Colour
        xCustom.Cells(18, 56).Interior.Color = Alt09Colour
        xCustom.Cells(19, 56).Interior.Color = Alt10Colour
        
        
        xCustom.Cells(56, 56).Interior.Color = AltZeroColour
        xCustom.Cells(57, 56).Interior.Color = Alt01Colour
        xCustom.Cells(58, 56).Interior.Color = Alt02Colour
        xCustom.Cells(59, 56).Interior.Color = Alt03Colour
        xCustom.Cells(60, 56).Interior.Color = Alt04Colour
        xCustom.Cells(61, 56).Interior.Color = Alt05Colour
        xCustom.Cells(62, 56).Interior.Color = Alt06Colour
        xCustom.Cells(63, 56).Interior.Color = Alt07Colour
        xCustom.Cells(64, 56).Interior.Color = Alt08Colour
        xCustom.Cells(65, 56).Interior.Color = Alt09Colour
        xCustom.Cells(66, 56).Interior.Color = Alt10Colour
    End Select
End Sub
 
Upvote 0
Could you indicate which specific line is erroring out? Have you tried placing a simple On Error Resume Next at the top of the code and established how much functionality remains (if all errors are effectively ignored)?
 
Upvote 0
Hi
The part on which it errors is :
Code:
With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

and when I on error resume the rest of the macro runs fine - just doesn't update the borders as I need it to. After the macro is run I still have the issue with the right click format cells menu not working.
 
Upvote 0
As far as I can see there is no reason why that code should bomb on xl97 compared to Excel 2010.

You can't recreate the problem can you because you only have xl2010? Are these clients using the code on a worksheet which has protection applied?
 
Upvote 0
Nope, there are no protection or restrictions on either side.

I have 2003 on my machine at home so tested it last night and it ran perfectly, ran on my work 2010 this morning and it bugged out again. But using the Error Resume Next it at least allows the code to run, but the borders are meant to highlight a particular range to identify peak from off peak time so it's an aspect I'd rather not sacrifice.
 
Upvote 0
If you can reliably generate the error (eg it will definitely happen if you run the macro x times) then I would suggest stepping thru the code using F8 to physically see what the selections are (and variable values) prior to the debug error. It may help point towards something is going awry.

Otherwise, would it be possible for you to send me a sample of the file? Remove any and all confidential data but do please ensure it still exhibits the problem.

If you want to go down this route, I will PM you my email address.
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,114,002
Members
448,543
Latest member
MartinLarkin

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