CODEWITHSUNDEEP
vbaexcel
ASH
ASH

Reputation: 20302

How can I set the width of certain columns?

I'm playing around with the code sample below.

Sub Hide_Columns_Containing_Value()

Dim c As Range
Dim ThisIsToday As Date
Dim TwoWeeksBack As Date
Dim ThreeMonthsAhead As Date

    ThisIsToday = Date
    TwoWeeksBack = ThisIsToday - 14
    ThreeMonthsAhead = ThisIsToday + 100

For Each c In Range("O4:XA4").Cells
If c.Value < TwoWeeksBack Or c.Value > ThreeMonthsAhead Then
    Range(c.Address).Select
    Selection.ColumnWidth = 1.75
    Else
        c.EntireColumn.Hidden = True
    End If
Next c

End Sub

Basically I want to loop through all cells and if the value is a date less than two seeks ago, or more than 3 months from now, I want to hide the column. The problem is that the dates are not in every cell; the dates are in every 7 cells, which represent every Friday. The hiding and showing of columns is not working like I want it to, because of all the blank cells.

Here is a screen shot of the dates.

enter image description here

Upvotes: 1

Views: 449

Answers (2)

paul bica
paul bica

Reputation: 10715

Is this what you were trying to do

Option Explicit

Public Sub HideColumnsContainingValue()

    Dim c As Range
    Dim thisIsToday As Date
    Dim twoWeeksBack As Date
    Dim threeMonthsAhead As Date

    thisIsToday = Date
    twoWeeksBack = thisIsToday - 14
    threeMonthsAhead = thisIsToday + 100

    For Each c In Range("O4:XA4").Cells
        With c
            If Len(.Value2) > 0 Then        'if not empty
                If IsDate(.Value) Then      'if date

                    If .Value < twoWeeksBack Or .Value > threeMonthsAhead Then
                        .EntireColumn.Hidden = True
                    Else
                        .ColumnWidth = 1.75
                    End If

                End If
            End If
        End With
    Next
End Sub

This version is a bit faster

Public Sub HideDatesNotInRange()
    Dim dateRng As Range, dateArr As Variant
    Dim c As Long, minDay As Date, maxDay As Date

    minDay = Date - 14
    maxDay = Date + 100
    Set dateRng = Range("O4:XA4")
    dateArr = dateRng                       'iterate over array

    Application.ScreenUpdating = False
    For c = 1 To UBound(dateArr, 2)
        If Len(dateArr(1, c)) > 0 Then      'if not empty
            If IsDate(dateArr(1, c)) Then   'if date
                With dateRng(1, c)
                    If dateArr(1, c) < minDay Or dateArr(1, c) > maxDay Then
                        .EntireColumn.Hidden = True
                    Else
                        .ColumnWidth = 1.75
                    End If
                End With
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Upvotes: 2

Doug Coats
Doug Coats

Reputation: 7107

Sub dostuff()
    Dim c As Range
    For Each c In Range("A:C").Columns
        c.ColumnWidth = 77
    Next c
End Sub

you should be able to fill in the blanks from here

Upvotes: 0

Related Questions