Excel macro pre 2016

[brutusbeats]

I have an Excel macro which works on Excel pre 2016 but not 2016 onwards. Does anyone know why this would no longer work on the newer versions?

Sub fun_create_sheets()
Dim sheetsNumber As Integer
Dim riskNumber As Integer

Dim I As Integer
Dim j As Integer
Dim k As Integer
Dim sheetCurrent As Integer
Dim workingSh As Variant
Dim temp As String
Dim rng As Range
Dim UsedRange As Range




    sheetsNumber = Sheets("Results").Range("E5").Value
   
    Sheets("Part C (0)").Visible = True
    Sheets("Part C (0)").Activate

    ' Delete old sheets containign "Part C("
    For Each sh In ActiveWorkbook.Worksheets
        'MsgBox (sh.Name)
        If InStr(sh.Name, "Part C (") Then
            If InStr(sh.Name, "Part C (0)") Or InStr(sh.Name, "Part C (Sign)") Then
                'MsgBox ("no borrar")
            Else
                'MsgBox ("borrar")
                Application.DisplayAlerts = False
                sh.Delete
                Application.DisplayAlerts = True
            End If
        End If
    Next sh
   
   

    ' Create new  Part C sheets if rquired
    If sheetsNumber >= 1 Then
       For I = 1 To sheetsNumber
        Sheets("Part C (0)").Select
        Sheets("Part C (0)").Copy Before:=Sheets(1)
        Sheets("Part C (" + CStr(0 + I) + ")").Select
        Sheets("Part C (" + CStr(0 + I) + ")").Move Before:=Sheets("Part C (Sign)")
    Next I
    End If
    Sheets("Part C (0)").Visible = False
   
    'Populate sheets
    riskNumber = Sheets("Results").Range("E3").Value
    sheetCurrent = 1
   
    For I = 1 To riskNumber
    Sheets("Part C (" + CStr(sheetCurrent) + ")").Select
   
        For j = 1 To 6
            'MsgBox (i)
            Application.CutCopyMode = False
            temp = "F" + CStr(1 + I)
            Sheets("Results").Range(temp).Copy
            temp = "C" + CStr(3 + j * 9)
           
            Range("E12:K20").Select
            Sheets("Part C (" + CStr(sheetCurrent) + ")").Select
            ActiveSheet.Range(temp).Select
            'MsgBox ("D")
            ActiveSheet.Paste
           
            temp = "G" + CStr(1 + I)
            Sheets("Results").Range(temp).Copy
            temp = "E" + CStr(3 + j * 9)
            Sheets("Part C (" + CStr(sheetCurrent) + ")").Select
            ActiveSheet.Range(temp).Select
            ActiveSheet.Paste
            I = I + 1
        Next j
        I = I - 1
       
        For k = 1 To 6
            temp = "AG" + CStr(3 + 9 * k)
            Set rng = Sheets("Part C (" + CStr(sheetCurrent) + ")").Range(temp)
            'MsgBox (rng.Address)
            rng.Formula = rng.Value
            rng.Value = rng.Value
        Next k
        sheetCurrent = sheetCurrent + 1
    Next I
           
   
End Sub

 

[MARK858]

Although I assume you did as you are now getting the Subscript out of range error (which is normally a naming/spelling error as Joe4 has stated), going back to post number 7, you did unselect the one with the "MISSING" and click OK (I am assuming you did as it has moved on to the other error but just want it confirmed that it is no longer showing as "MISSING")?

 

[brutusbeats]

Changed the Sheet no. to (1) as there is no (0) sheet. Had to change Dim Sh as Worksheet to Dim Sh as Worksheets as it was deleting all but one of the Part C sheets. I now have this error which I have previously got to but no idea how to get past this one.

 

[brutusbeats]

Although I assume you did as you are now getting the Subscript out of range error (which is normally a naming/spelling error as Joe4 has stated), going back to post number 7, you did unselect the one with the "MISSING" and click OK (I am assuming you did as it has moved on to the other error but just want it confirmed that it is no longer showing as "MISSING")?

It will not let me uncheck the MISSING Microsoft Windows Common Controls as it says it is in use

 

[Joe4]

Changed the Sheet no. to (1) as there is no (0) sheet. Had to change Dim Sh as Worksheet to Dim Sh as Worksheets as it was deleting all but one of the Part C sheets. I now have this error which I have previously got to but no idea how to get past this one.

View attachment 96168

View attachment 96169

You changed the "ws" reference on the "For each" line, but not on the line showing the error.
You need to change those "ws" references to "workingSh", to match the other change!

I would get rid of all your "Sh" references in this code. It is clearly interfering with something else.
Maybe you have a global variable or function or procedure already using that name.

 

[brutusbeats]

You changed the "ws" reference on the "For each" line, but not on the line showing the error.
You need to change those "ws" references to "workingSh", to match the other change!

I would get rid of all your "Sh" references in this code. It is clearly interfering with something else.
Maybe you have a global variable or function or procedure already using that name.

It stil doesn't work

 

[Joe4]

Do you have other VBA code in this workbook?
What does that look like ?

Instead of chasing our tail and guessing what else you have going on in this workbook, it would probably be best if you could upload a copy of it to a file sharing site and provide the link to it here, so we can download it and debug it for ourselves. Just be sure to remove any sensitive data first.

 

[MARK858]

if you could upload a copy of it to a file sharing site

Probably find you'll have trouble opening it if it is giving 32829 error (but we'll see once it has been uploaded )

 

[Joe4]

Probably find you'll have trouble opening it if it is giving 32829 error (but we'll see once it has been uploaded )

You must have great eyes. Those images are no small, I cannot read all the small text!

Do you suspect it might be a corruption issue?

 

[brutusbeats]

This one is there but not in use

Sub fun_copy_results()
'
' fun_copy_results Macro
'

Sheets("Results").Visible = True
Sheets("Results").Activate
With Sheets("Results")
Range("C2:D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("F2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("F2:G95")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Sheets("Results").Visible = False
End Sub


Another one not used as far as i'm aware

Sub Macro1()
'
' Macro1 Macro
'

'
'Range("B79").Select
'Sheets(Array("Front Sheet", "Part A", "Part B", "Part C (1)", "Part C (2)", _
' "Part C (Sign)", "Part E", "Part F ")).Select
'Sheets("Front Sheet").Activate

'Sub gram_em()

Dim ws As Worksheet

For Each ws In Sheets

If ws.Visible Then ws.Select (False)

Next

End Sub


'End Sub

This one works and is to Save to pdf.

Sub SaveActiveWorkbookAsPDF()

'Create and assign variables
Dim saveLocation As String
saveLocation = "C:\Users\User\Downloads\" & Range("E4").Value
'Save active workbook as PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation

End Sub

This one is to print all workbooks

Sub sendtoprintcolor()
'
' sendtoprintcolor Macro
'

'
ActiveWorkbook.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

 

[brutusbeats]

You must have great eyes. Those images are no small, I cannot read all the small text!

Do you suspect it might be a corruption issue?

If I try to send them bigger, this site says are too big!! No, it's a file from work which others have and they work on their laptops as they have older versions of Excel but doesn't work on any of the new laptops