It can be hard to work on multi-column sheets overflowing from the screen horizontally, so we try to fit the sheet view to the screen by hiding some columns. We have designed a user form to make it easy to hide and un-hide worksheet columns.
YoutubeForm Sources Code
'For More : https://MSexcelVBA.com
#If VBA7 Then
Private Declare PtrSafe Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLongA Lib "user32" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLongA Lib "user32" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#Else
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLongA Lib "user32" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
Public yukleme As Variant
Dim r, lst_column As Long
'
Private Sub CheckBox1_Click() ' To select all listbox items
Dim Col As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If CheckBox1.Value = True Then
For r = 0 To ListBox1.ListCount - 1
ListBox1.Selected(r) = True
Next r
Else
For r = 0 To ListBox1.ListCount - 1
ListBox1.Selected(r) = False
Next r
End If
Col = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).End(xlToLeft).Column
ActiveSheet.Columns(Col).Cells(1, 1).Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.ComboBox1.DropDown
End Sub
Private Sub ComboBox1_Change()
Dim sht As Long, sr As Integer
Application.ScreenUpdating = False
Sheets(ComboBox1.Value).Activate
ListBox1.Clear
lst_column = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
If yukleme = "ok" Then
For sht = 1 To lst_column
ListBox1.AddItem Split(Sheets(ComboBox1.Value).Cells(1, sht).Address, "$")(1) & " " & " " & "-" & Cells(1, sht).Value
If Sheets(ComboBox1.Value).Columns(sht).Hidden = True Then
ListBox1.Selected(sht - 1) = True
End If
Next
For sr = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(sr) = True Then
Sheets(ComboBox1.Value).Cells(1, Split(ListBox1.List(sr, 0))(0)).EntireColumn.Hidden = True
Else
Sheets(ComboBox1.Value).Cells(1, Split(ListBox1.List(sr, 0))(0)).EntireColumn.Hidden = False
End If
Next
End If
Application.ScreenUpdating = True
End Sub
Private Sub ListBox1_Change() 'The columns that selected on listbox are hidden.
Dim sr As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If yukleme = "ok" Then
For sr = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(sr) = True Then
ActiveSheet.Cells(1, Split(ListBox1.List(sr, 0))(0)).EntireColumn.Hidden = True
Else
ActiveSheet.Cells(1, Split(ListBox1.List(sr, 0))(0)).EntireColumn.Hidden = False
End If
Next
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub UserForm_Initialize()
Dim cnt As Integer
With Me 'Userform is displayed in the upper right corner of the screen.
.Left = (Application.Width - .Width) - 7
.Top = 0
End With
For cnt = 1 To ThisWorkbook.Worksheets.Count 'The sheets of workbook is added to combobox.
ComboBox1.AddItem Sheets(cnt).Name
Next cnt
ComboBox1.Value = ActiveSheet.Name
lst_column = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For sht = 1 To lst_column 'The used columns of worksheets with column headers are listed on listbox.
ListBox1.AddItem Split(Sheets(ComboBox1.Value).Cells(1, sht).Address, "$")(1) & " " & " " & "-" & Cells(1, sht).Value
If Sheets(ComboBox1.Value).Columns(sht).Hidden = True Then
ListBox1.Selected(sht - 1) = True
End If
Next
yukleme = "ok"
End Sub
Private Sub UserForm_Activate()
Dim hWnd As Long, exLong As Long
hWnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hWnd, -16)
If (exLong And &H20000) = 0 Then
SetWindowLongA hWnd, -16, exLong Or &H20000
Me.Hide
Me.Show
End If
End Sub
Private Sub UserForm_Terminate()
yukleme = "close"
End Sub
Code Explanation:
#If VBA7 Then
Private Declare PtrSafe Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLongA Lib "user32" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLongA Lib "user32" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#Else
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLongA Lib "user32" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
Public yukleme As Variant
Dim r, lst_column As Long
IF VBA 7 Then Run first 6 Line Else Run Bottom 6 line and declare variable
Dim Col As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Defined variable and turn off screen update and display alerts
If CheckBox1.Value = True Then
For r = 0 To ListBox1.ListCount - 1
ListBox1.Selected(r) = True
Next r
Else
For r = 0 To ListBox1.ListCount - 1
ListBox1.Selected(r) = False
Next r
End If
If Check Box Not Null Then Selection True (R) Column Loop
Col = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).End(xlToLeft).Column
ActiveSheet.Columns(Col).Cells(1, 1).Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
set col , active sheet column activate, screen update, display alerts.
Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.ComboBox1.DropDown
End Sub
When Mouse Move On Drop down then Drop down Papulate.
Dim sht As Long, sr As Integer
Application.ScreenUpdating = False
Sheets(ComboBox1.Value).Activate
ListBox1.Clear
lst_column = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
If yukleme = "ok" Then
For sht = 1 To lst_column
ListBox1.AddItem Split(Sheets(ComboBox1.Value).Cells(1, sht).Address, "$")(1) & " " & " " & "-" & Cells(1, sht).Value
If Sheets(ComboBox1.Value).Columns(sht).Hidden = True Then
ListBox1.Selected(sht - 1) = True
End If
Next
For sr = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(sr) = True Then
Sheets(ComboBox1.Value).Cells(1, Split(ListBox1.List(sr, 0))(0)).EntireColumn.Hidden = True
Else
Sheets(ComboBox1.Value).Cells(1, Split(ListBox1.List(sr, 0))(0)).EntireColumn.Hidden = False
End If
Next
End If
Application.ScreenUpdating = True
Defined Variable. Sheets Activate .
Dim sr As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If yukleme = "ok" Then
For sr = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(sr) = True Then
ActiveSheet.Cells(1, Split(ListBox1.List(sr, 0))(0)).EntireColumn.Hidden = True
Else
ActiveSheet.Cells(1, Split(ListBox1.List(sr, 0))(0)).EntireColumn.Hidden = False
End If
Next
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Column Hide OR Unhide When List box Selected column
With Me 'Userform is displayed in the upper right corner of the screen.
.Left = (Application.Width - .Width) - 7
.Top = 0
End With
Set User form Position
Dim cnt As Integer
For cnt = 1 To ThisWorkbook.Worksheets.Count 'The sheets of workbook is added to combobox.
ComboBox1.AddItem Sheets(cnt).Name
Next cnt
ComboBox1.Value = ActiveSheet.Name
lst_column = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
The sheets of workbook is added In Combobox
For sht = 1 To lst_column 'The used columns of worksheets with column headers are listed on listbox.
ListBox1.AddItem Split(Sheets(ComboBox1.Value).Cells(1, sht).Address, "$")(1) & " " & " " & "-" & Cells(1, sht).Value
If Sheets(ComboBox1.Value).Columns(sht).Hidden = True Then
ListBox1.Selected(sht - 1) = True
End If
Next
yukleme = "ok"
The used columns of worksheets with column headers are listed on listbox.
Private Sub UserForm_Activate()
Dim hWnd As Long, exLong As Long
hWnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hWnd, -16)
If (exLong And &H20000) = 0 Then
SetWindowLongA hWnd, -16, exLong Or &H20000
Me.Hide
Me.Show
End If
End Sub