Current Macro is not keeping the dropdown menus in tact. When the macro finishes, the 2 dropdown columns are just normal columns (Columns L and N). The code is below, as well as in the attached sample file. The macro is designed for the user to select a few Doc IDs in Column E on the sheet named Impact, then click the macro button on Instructions. A new sheet will be created with only the Doc IDs that were selected (visible rows) on a new sheet, Book 1. And now (there were some recent upgrades made), the dropdowns don't "stay". I don't understand why this is or where the error is. Thanks in advance!!!
Sub CopyVisibleNewWkbook()
' Optimize Macro Speed
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim newBook As Excel.Workbook
Dim rng As Excel.Range
Set newBook = Workbooks.Add
Set rng = ThisWorkbook.Worksheets("Impact").Cells.SpecialCells(xlCellTypeVisible)
' Auto data
rng.Copy newBook.Worksheets("Sheet1").Range("A1")
Cells.Select
Cells.EntireColumn.AutoFit
' Convert Range to Table
Set rng = Range("A1").CurrentRegion 'Change to match your range
ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = "tbl_data"
' Change Font to Black
' Formulas - Applicable in MAP to Helper
Range("K:Q").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
' Sort
Call MySort
' Delete Unneeded Columns
' Helper
Range("Q:Q").Delete
' Starting Cell
' activates cell
Range("A1").Select
' Reset Macro Optimization Settings
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub MySort()
Dim lngLast As Long
lngLast = Range("A" & Rows.Count).End(xlUp).Row
On Error GoTo Whoa 'in honor of Siddhart Rout (I like that :))
With Worksheets("Sheet1").Sort
.SortFields.Clear
' 1st sort column - Doc ID
.SortFields.Add Key:=Range("E1:E" & lngLast), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' 2nd sort ccolumn - Applicable QMS Entity
.SortFields.Add Key:=Range("C1:C1" & lngLast), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A1:Q" & lngLast) ' Q is new last column
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
On Error GoTo 0
Exit Sub
Whoa:
MsgBox "Error " & Err.Number & " " & Err.Description, vbOKOnly
End Sub
The cose reads okay and I don't see any issues there, but which 'dropdown menus' are you talking about?
Another point if you require help is to indicate the Excel version you're using and also if the other user(s) will be working with the same version
@Hans Hallebeek,
Sorry about that. First the Dropdown menus are currently in the sample file as they exist in my live file. The dropdown options are as follows:
Column L: In Scope: Inactivate, In Scope: Obsolesce, In Scope: Replicate, In Scope: Tailor, In Scope: Use Direct, Out of Scope, Unknown
Column N: Yes, No
In the sample file, both of these columns show the dropdown menus correctly. The issue is some these dropdowns are removed when this copy macro is run. These 2 columns just become normal columns with no dropdown options.
These dropdown options are part of the data validation list as this becomes a "stan alone" sheet for the users. This was never an issue before, but recently there were some upgrades. However, I cannot find anything such as "convert to values" or otherwise that would remove the dropdowns. And I must figure out how to add it back in, and keep the file as an "xlsx" (macro free workbook) for the end user.
Looking a little further you have to check if the data validation is copied too.
I think this is where the problem lies.
You need to check if a cell has data validation and copy the data validation too.
There's some sample code in this post you might be able to use
Hope it helps.
And ... you still have not told us which version of Excel you're using
@Hans Hallebeek,
This past week has been all kinds of crazy! and 4 new projects dumped on me that required completion yesterday! Okay I will look at that site and see. And I am using Office 365 (Version 2307). I will check back in after I can see how to appply the code from the StackOverflow link. Thank you.
Great, let us know how it goes
