Here's the code. By the way, you need to remove the trailing space in the Employees sheet tab. Otherwise, the code below will throw an error.
Code:
Sub Columninput()
Dim lng As Long
Dim lngTotalEmployees As Long
Dim lngCol As Long
For lngCol = 8 To Worksheets("Employees").Cells(1, Columns.Count).End(xlToLeft).Column
lngTotalEmployees = lngTotalEmployees + 1
If Worksheets("Employees").Cells(1, lngCol).Value <> lngTotalEmployees Then
Exit For
End If
Next lngCol
lngTotalEmployees = lngTotalEmployees - 1
lng = Worksheets("Monitoring Info.").Range("C9").Value
If lng > lngTotalEmployees Then
For lngCol = 1 To lng - lngTotalEmployees
Worksheets("Employees").Columns(8 + lngTotalEmployees - 1).Insert xlToRight
Worksheets("Employees").Cells(1, 8 + lngTotalEmployees - 1).Value = lngTotalEmployees + lngCol
Next lngCol
With Worksheets("Employees").Sort
.SortFields.Clear
.SortFields.Add Key:=.Parent.Range("H1").Resize(, lng), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange .Parent.Range("H1").Resize(, lng)
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
ElseIf lng < lngTotalEmployees Then
Worksheets("Employees").Columns(8 + lng).Resize(, lngTotalEmployees - lng).Delete xlToLeft
Else
MsgBox "No change!", vbOKOnly, "Delete Employee Columns"
End If
End Sub
Bookmarks