Debugging my formatting module

BrandynBlaze

New Member
Joined
Sep 20, 2012
Messages
29
So I don't know what's going wrong with my code, it's just designed to automate a formatting task that I repeat often at work. I've put comments in for all the subroutines to explain them but basically it finds the used range, borders it, formats the headers, uses select case to find specific instances of headers and assigns color properties to them, then parses the headers column and assigns the same color value to empty cells or gray to cells that have values. Right now it's throwing an error for a type mismatch in the SelectCellColor() subroutine even though I know it's the correct type.

I'm sure this code could be improved greatly and maybe a couple of subroutines could be combined but I wanted them as separate as possible when I was debugging it. It's also the first program I've written in VB and haven't programmed much of anything in several years so I'm definitely open to any suggestions for improving it beyond just getting it running.

Thanks!

Code:
Public LstRw As Long, LstCol As Long
Public HeaderTheme As String, HeaderTint As Double


Sub FindUsedRange()
   'Uses find function to set used cell range


    LstRw = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
    LstCol = Cells.Find(What:="*", SearchOrder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column
    
    Call BorderUsedRange


End Sub
Sub BorderUsedRange()


    'Borders Used Cell Range
    
    ActiveSheet.Cells.ClearFormats
    
    With Range(Cells(1, 1), Cells(LstRw, LstCol))
        .Borders.Weight = xlThin
        .Font.Bold = False
    End With


    Range(Cells(1, 1), Cells(1, LstCol)).Font.Bold = True
    
    Call FormatTopRow
    
End Sub


Sub FormatTopRow()


'Selects top row and gives it thick borders with thin borders inbetween.


    Range(Cells(1, 1), Cells(1, LstCol)).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


    Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
    Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous


    Cells.Select
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    
    Call FindHeaders
    
End Sub


Sub FindHeaders()


    'Parses Headers and uses Select Case to assign Color Values for specific Cases


    Range("A1").Select
    
    Dim i As Integer
    Dim Header As String
    
    For i = 1 To LstCol
    
    Header = ActiveCell.Value
    
    Select Case Header
    
        Case "FEA":
        
        HeaderTheme = "xlThemeColorAccent2"
        HeaderTint = 0.6
        
        Call SelectCellColor
        
        Case "SUN":
        MsgBox "Found Sun"
    
    End Select
    
    ActiveCell.Offset(0, 1).Select


Next i




End Sub


Sub SelectCellColor()
  
    'Assigns color to Header
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = HeaderTheme
        .TintAndShade = HeaderTint
        .PatternTintAndShade = 0
    End With
    
    MsgBox "Going to FormatColumn"
    
    Call FormatColumn
    
End Sub


Sub FormatColumn()


    'Parses column and assigns header color to cells with values, gray to cells that are blank
    
    Dim j As Integer


    For j = 2 To LstRw
    
        Cells(j, ActiveCell.Column).Activate
        
        If ActiveCell.Value = "" Then
        
            With Range(Cells(j, i)).Value.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = HeaderTheme
                .TintAndShade = HeaderTint
                .PatternTintAndShade = 0
        End With
        
        Else
            With Range(Cells(j, i)).Value.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent1 'Haven't assigned color values for gray yet
                .TintAndShade = 1
                .PatternTintAndShade = 0
            End With
            
        End If


    Next j
        
End Sub
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Firefly2012

Well-known Member
Joined
Dec 28, 2011
Messages
3,638
Hi

ThemeColor expects an enumeration ie a Long value, not a string.

Try replacing

Public HeaderTheme As String

with

Public HeaderTheme As Long

and setting it to

HeaderTheme = 6
 

BrandynBlaze

New Member
Joined
Sep 20, 2012
Messages
29
Well that got me a little further but now I'm getting an error in Sub FormatColumn() at With Range(Cells(j, i)).Value.Interior for Method 'Range' of object '_Global' failed.
 

Firefly2012

Well-known Member
Joined
Dec 28, 2011
Messages
3,638

ADVERTISEMENT

Do you perhaps mean:

Code:
With Cells(j, i).Interior
 

BrandynBlaze

New Member
Joined
Sep 20, 2012
Messages
29
Wow, not sure how I let that one get past me... You have been a tremendous help so far!

Now that it runs through all the procedures the only thing I think I need to figure out is how to get back to my For Loop back in FindHeaders() so it can continue checking the headers? As it is the program just finishes once it finds "FEA" in the Header and doesn't find "SUN"...
 

Firefly2012

Well-known Member
Joined
Dec 28, 2011
Messages
3,638

ADVERTISEMENT

You only have the Case statement for FEA in your header loop - presumably you will want to include one for SUN too
 

BrandynBlaze

New Member
Joined
Sep 20, 2012
Messages
29
I do have a case for "SUN" in my Case statements but right now it just MsgBoxs "Sun" when it's reached. What I'm worried about is returning to my for loop so that all of the columns are parsed for all of the cases, as it is right now it just finds FEA, formats that column and then ends the program. I tried using a GoTo statement to get back to the end of the Select Case statement so that it would continue on to the next column but I can't between us it between subroutines.
 

Firefly2012

Well-known Member
Joined
Dec 28, 2011
Messages
3,638
Have you tried stepping through the code in the VBE using F8 to determine whether control is passed back to the calling routine (ie the one that has the Select Case) and whether all headers are actually being iterated over (which, if they are, might suggest other reasons why it isn't working eg your header doesn't contain exactly "SUN" for example)?
 

BrandynBlaze

New Member
Joined
Sep 20, 2012
Messages
29
I didn't know could you even do that! That's awesome! The problem was that the active cell wasn't returning to the first row so it was parsing the bottom of my used range and not finding anything. I think that should do it for the debugging, now I just need to set all the cases for my headers and it should be done. Thanks a ton guys, couldn't have done it without you, hopefully I can pay it back to someone else in the forums in the future.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,311
Messages
5,600,886
Members
414,414
Latest member
neil_c

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
Top