As you all know, I am not a VBA expert! I am looking for a bit of help again with a macro I got working with your help just under a year ago.
The macro is supposed to copy a worksheet and, in doing so, convert the formula results in rows 2:4 into values. This bit was working last year, but isn't now.
I am not trying to create the workbook in a network area.
The original worksheet looks like this:
Excel 2016 (Windows) 32 bit
|
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
M |
N |
O |
P |
Q |
R |
S |
T |
U |
2 |
Year Groups &
Teaching Groups |
|
Department Staff Initials |
|
HoD |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
3 |
|
|
|
|
HLB |
DKH |
JP |
JWPM |
MRH |
|
|
|
|
|
|
|
|
|
|
|
|
4 |
|
|
Staff Allocations |
|
40 |
46 |
42 |
30 |
28 |
|
|
|
|
|
|
|
|
|
|
|
|
5 |
|
|
No. of periods
per fortnight |
Totals |
0 |
0 |
0 |
6 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
and the resulting sheet comes out like this:
Excel 2016 (Windows) 32 bit
|
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
M |
N |
O |
P |
Q |
R |
S |
T |
U |
2 |
Year Groups &
Teaching Groups |
|
Department Staff Initials |
|
HoD |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
3 |
|
|
|
|
#N/A |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
4 |
|
|
Staff Allocations |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
5 |
|
|
No. of periods
per fortnight |
Totals |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
Not that it should matter, the two formulae used in the original are:
=LOOKUP(2,1/((Departments[Department]=$H$1)*(Departments[HoD]="*")),Departments[Initials])
and:
=IFNA(IF(E3="","",INDEX(Staff[Expected Load],MATCH(E3,Staff[Initials],0))),"")
Whilst getting this sorted, I would also like to have the macro copy values instead of formulae from A1, B2:U4 (instead of 2:4) and E94:U104.
As always, your help is very much appreciated.
Here's the VBA code:
Private Sub UserForm_Initialize()
Dim sh As Worksheet
With LstPrint
.Clear
For Each sh In Worksheets
If sh.Name <> "1. Staff List & Subjects" And sh.Name <> "2. Staff Allocation Checklist" And sh.Name <> "Proforma" And sh.Name <> "3. Roles & Responsibilities" And sh.Name <> "Rooms" Then .AddItem sh.Name
Next
End With
End Sub
Private Sub CmdPrint_Click()
Dim DateString As String
Dim FolderName As String
Dim x As Long
Dim FileFormatNum As Long
'Dim xFile As String
Dim FileExtStr As String
Application.ScreenUpdating = False
DateString = Format(Now, "dd mmmm yyyy")
FolderName = "C:\Users\Alison\Users\Alison\OneDrive\Documents\Timetable - Staffing Grids" & " " & DateString
For x = 0 To LstPrint.ListCount - 1
If LstPrint.Selected(x) = True Then
Application.CopyObjectsWithCells = False
With Sheets(LstPrint.List(x))
If .ProtectContents = True Then
.Unprotect
.Copy
.Protect
Else
.Copy
End If
End With
Application.CopyObjectsWithCells = True
With ActiveWorkbook
.Sheets(1).Rows("2:4").Value = .Sheets(1).Rows("2:4").Value
.Sheets(1).Protect
If .HasVBProject Then
FileFormatNum = 52
Else
FileFormatNum = 51
End If
xFile = FolderName & "\" & .Sheets(1).Name & FileExtStr
'xFile = FolderName & "\" & Replace(.Sheets(1).Name, Chr(32), "-") & FileExtStr
.SaveAs xFile, FileFormat:=FileFormatNum
.Close False
End With
End If
Next
Application.ScreenUpdating = True
Unload Me
End Sub
I am using Office 365 on a Windows 10 machine (all up-to-date).
Thank you!
Bookmarks