Hi All,
I have a questionnaire that i use macros to fix user changes to appearance and manage visible information depending on the assessment step underway. The problem i have is that more frequently than not i am being told by businesses that they block macro enabled workbooks. so i spend unsurmountable time resetting the workbook for each step along the assessment process.
As for the macros, I know i could break them out and send a normal xls that when i get it back i could connect to it and then run the macros individually on the sheets - but that is so painful. And obviously i know how to copy macros... but that is an absolute pain to add them every time a vendor responds only to have the workbook come back a mess and then reimport them to fix.
I need a better method and though an answer may seem simple or logical to someone else... it is not to me so im looking for help. I am completely willing to share the workbook and explain the process.
I have a co-worker that says he can fix it but also said it will take him months to do it and we dont have months. so im coming to the experts of Excel to ask for help.
thank you in advance for any help.
The macros are below, and i am embarrassed to share but i really want help and dont care that im a noob to excel coding.
AUDIT_ME checks the value in a field and then resets the sheet based on the selection; locking, showing and hiding ranges based on that value.
RANGEFORMAT resets the column widths and forces the row height to match the largest content of a row.
//code *****************************************************
Sub audit_me()
Dim rng As Range
Set rng = Range("$F$1")
Application.ScreenUpdating = False
If rng.Value = "0" Then
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect
'Fully unlock page
.Range("C3", "M100").Locked = False
.Range("E3", "F100").Locked = True
.Range("E:M,AA:AO").EntireColumn.Hidden = False
End With
End If
If rng.Value = "1" Then
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect
.Range("C3", "D100").Locked = False 'Lock the range K3 to L100
.Range("E3", "L100").Locked = True 'Lock the range K3 to L100
.Range("G:M,AA:AO").EntireColumn.Hidden = True
.Protect
.EnableSelection = xlUnlockedCells
End With
End If
If rng.Value = "2" Then
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect
.Range("E3", "L100").Locked = True 'Lock the range K3 to L100
.Range("C3", "D100").Locked = True 'Lock the range K3 to L100
.Columns("J:M").EntireColumn.Hidden = False
.Range("G:I,AA:AO").EntireColumn.Hidden = True
.Range("M3", "M100").Locked = False
.Protect
.EnableSelection = xlUnlockedCells
End With
Application.ScreenUpdating = True
End If
If rng.Value = "6" Then
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect
'Reset ranges
.Range("C3", "M100").Locked = False
.Range("E3", "F100").Locked = True
.Range("E:M,AA:AN").EntireColumn.Hidden = False
'Reset filters
'Set ranges for audit
.Range("C3", "M100").Locked = False
.Range("E3", "F100").Locked = True
.Columns("G:I").EntireColumn.Hidden = False
.Range("E:E,I:I,AA:AO").EntireColumn.Hidden = True
.EnableSelection = xlUnlockedCells
'Leave unprotected so that linefeeds do not make audit difficult
End With
End If
If rng.Value = "7" Then
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect
.AutoFilter.Sort.SortFields.Clear
'Lock entire page
.Range("A3", "M100").Locked = True
.Columns("G:I").EntireColumn.Hidden = False
.Range("E:E,G:G,I:I,AA:AO").EntireColumn.Hidden = True
.Protect
.EnableSelection = xlUnlockedCells
End With
End If
End Sub
********************************************
Sub rangeFormat()
Dim formatRng As Range, minHeight
Application.ScreenUpdating = False
Columns("A").ColumnWidth = 12
Columns("B").ColumnWidth = 80
Columns("C").ColumnWidth = 15
Columns("D").ColumnWidth = 80
Columns("E").ColumnWidth = 55
Columns("J").ColumnWidth = 15
Columns("K").ColumnWidth = 55
Columns("L").ColumnWidth = 80
Columns("M").ColumnWidth = 80
Set formatRng = Range("D3:M100")
minHeight = 50
formatRng.WrapText = True
formatRng.Rows.AutoFit
Dim rng As Range
For Each rng In Range("D3:M100")
rng.RowHeight = Application.WorksheetFunction.Max(rng.RowHeight, minHeight)
Next rng
Application.ScreenUpdating = True
End Sub
I have a questionnaire that i use macros to fix user changes to appearance and manage visible information depending on the assessment step underway. The problem i have is that more frequently than not i am being told by businesses that they block macro enabled workbooks. so i spend unsurmountable time resetting the workbook for each step along the assessment process.
As for the macros, I know i could break them out and send a normal xls that when i get it back i could connect to it and then run the macros individually on the sheets - but that is so painful. And obviously i know how to copy macros... but that is an absolute pain to add them every time a vendor responds only to have the workbook come back a mess and then reimport them to fix.
I need a better method and though an answer may seem simple or logical to someone else... it is not to me so im looking for help. I am completely willing to share the workbook and explain the process.
I have a co-worker that says he can fix it but also said it will take him months to do it and we dont have months. so im coming to the experts of Excel to ask for help.
thank you in advance for any help.
The macros are below, and i am embarrassed to share but i really want help and dont care that im a noob to excel coding.
AUDIT_ME checks the value in a field and then resets the sheet based on the selection; locking, showing and hiding ranges based on that value.
RANGEFORMAT resets the column widths and forces the row height to match the largest content of a row.
//code *****************************************************
Sub audit_me()
Dim rng As Range
Set rng = Range("$F$1")
Application.ScreenUpdating = False
If rng.Value = "0" Then
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect
'Fully unlock page
.Range("C3", "M100").Locked = False
.Range("E3", "F100").Locked = True
.Range("E:M,AA:AO").EntireColumn.Hidden = False
End With
End If
If rng.Value = "1" Then
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect
.Range("C3", "D100").Locked = False 'Lock the range K3 to L100
.Range("E3", "L100").Locked = True 'Lock the range K3 to L100
.Range("G:M,AA:AO").EntireColumn.Hidden = True
.Protect
.EnableSelection = xlUnlockedCells
End With
End If
If rng.Value = "2" Then
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect
.Range("E3", "L100").Locked = True 'Lock the range K3 to L100
.Range("C3", "D100").Locked = True 'Lock the range K3 to L100
.Columns("J:M").EntireColumn.Hidden = False
.Range("G:I,AA:AO").EntireColumn.Hidden = True
.Range("M3", "M100").Locked = False
.Protect
.EnableSelection = xlUnlockedCells
End With
Application.ScreenUpdating = True
End If
If rng.Value = "6" Then
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect
'Reset ranges
.Range("C3", "M100").Locked = False
.Range("E3", "F100").Locked = True
.Range("E:M,AA:AN").EntireColumn.Hidden = False
'Reset filters
'Set ranges for audit
.Range("C3", "M100").Locked = False
.Range("E3", "F100").Locked = True
.Columns("G:I").EntireColumn.Hidden = False
.Range("E:E,I:I,AA:AO").EntireColumn.Hidden = True
.EnableSelection = xlUnlockedCells
'Leave unprotected so that linefeeds do not make audit difficult
End With
End If
If rng.Value = "7" Then
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect
.AutoFilter.Sort.SortFields.Clear
'Lock entire page
.Range("A3", "M100").Locked = True
.Columns("G:I").EntireColumn.Hidden = False
.Range("E:E,G:G,I:I,AA:AO").EntireColumn.Hidden = True
.Protect
.EnableSelection = xlUnlockedCells
End With
End If
End Sub
********************************************
Sub rangeFormat()
Dim formatRng As Range, minHeight
Application.ScreenUpdating = False
Columns("A").ColumnWidth = 12
Columns("B").ColumnWidth = 80
Columns("C").ColumnWidth = 15
Columns("D").ColumnWidth = 80
Columns("E").ColumnWidth = 55
Columns("J").ColumnWidth = 15
Columns("K").ColumnWidth = 55
Columns("L").ColumnWidth = 80
Columns("M").ColumnWidth = 80
Set formatRng = Range("D3:M100")
minHeight = 50
formatRng.WrapText = True
formatRng.Rows.AutoFit
Dim rng As Range
For Each rng In Range("D3:M100")
rng.RowHeight = Application.WorksheetFunction.Max(rng.RowHeight, minHeight)
Next rng
Application.ScreenUpdating = True
End Sub