Is there a way to shift over cells to the left in excel using VBA?-CodePudding

Is there a way to count the values in each column under the year and down to the last name, and if the count is 0, then shift the column on the right over into its place? For example, column 2020 has no values. Can I take 2021 and any succeeding columns and move them to the left? I attached a before and after image to show what I am trying to accomplish. Is someone able to point me in the right direction? Thank you!

Start - https://ibb.co/WfQ91D4 Finish - https://ibb.co/Jv6gf7Q

CodePudding user response：

Remove Blank Data (Entire) Columns

Sub RemoveBlankDataColumns()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!

    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    Dim rCount As Long: rCount = rg.Rows.Count - 1
    Dim drg As Range: Set drg = rg.Resize(rCount).Offset(1)
    
    Dim rgDel As Range
    Dim crg As Range
    
    For Each crg In drg.Columns
        If Application.CountBlank(crg) = rCount Then
            If rgDel Is Nothing Then
                Set rgDel = crg
            Else
                Set rgDel = Union(rgDel, crg)
            End If
        End If
    Next crg
    
    If rgDel Is Nothing Then
        MsgBox "No blank columns found.", vbExclamation
    Else
        rgDel.EntireColumn.Delete
        MsgBox "Blank data columns removed.", vbInformation
    End If
    
End Sub