Move macros to a seperate workbook

godcsu

New Member
Joined
Sep 17, 2021
Messages
1
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
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

Forum statistics

Threads
1,147,560
Messages
5,741,825
Members
423,689
Latest member
Jords998

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top