VBA transposing list losing leading 0

[gruntingmonkey]

Hello, I have an issue where I have a list on an excel sheet which I need to transpose to put in an array (sheet names) but it loses any leading 0s which means it doesn't recognise the tabs.

Dim oWS As Worksheet
Dim aSheetnames As Variant
Set oWS = Worksheets("Compiler")

endrow = ActiveSheet.Cells(Rows.Count, "O").End(xlUp).Row
aSheetnames = oWS.Range("O16:o" & endrow & "")

aSheetnames = Application.WorksheetFunction.Transpose(aSheetnames)
Worksheets(aSheetnames).Select

It debugs on the last line with a Run-time error 9, Subscript out of range.

Can anyone help?

 

[Peter_SSs]

That would be likely to happen if 'Compiler' is not the active sheet when the code is run. What happens if you change that line with ActiveSheet to

endrow = oWS.Cells(Rows.Count, "O").End(xlUp).Row

 

[gruntingmonkey]

Same error still happens at the same point.
The above is the condensed code and it does specify the sheet name in the actual code.

 

[Peter_SSs]

The above is the condensed code and it does specify the sheet name in the actual code.

Perhaps we could have the actual code and details of a few worksheet names and values in O16, O17 etc from 'Compiler'? Asking because with the test workbook I have set up, the code posted above works fine.

 

[footoo]

.

 

[gruntingmonkey]

Sub ArchiveFile()

Dim oWS As Worksheet
Dim aSheetnames As Variant
Set oWS = Worksheets("Compiler")

Sheets("Compiler").Select

rownum = 12
For i = 2 To Sheets.Count
    Sheets("Compiler").Cells(rownum, 15) = Sheets(i).Name
rownum = rownum + 1
Next i


startRow = Format(Cells(16, 15).Value, "000000")

'startRow = Cells(16, 15).Value
EndRowVal = Format(ActiveSheet.Cells(Rows.Count, "O").End(xlUp).Value, "000000")
'EndRowVal = ActiveSheet.Cells(Rows.Count, "O").End(xlUp).Value
endrow = ActiveSheet.Cells(Rows.Count, "O").End(xlUp).Row

If startRow <> "" Then
'endrow = oWS.Cells(Rows.Count, "O").End(xlUp).Row
aSheetnames = oWS.Range("O16:o" & endrow & "")

aSheetnames = Application.WorksheetFunction.Transpose(aSheetnames)
Worksheets(aSheetnames).Select
Worksheets(aSheetnames).Move
    Filename = "" & startRow & "-" & EndRowVal & ""
    
    ActiveWorkbook.SaveAs Filename:= _
        "\\spml.co.uk\allshares\data\datahwyc\Groups\Group Change\PMO\Methodology\PMO Activities\Cost Tracker\Receipting Archive\Receipt Archive File " + Filename + " .xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    
Sheets("Compiler").Select

MsgBox "Archive created"

Else
MsgBox "There are not enough tabs to archive"
End If

Workbooks(ThisWorkbook.Name).Activate


Sheets("Compiler").Select
    Range("O12").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A1").Select
End Sub

In cells O16, O17 is 040817 and 060817

I have noticed that I have formatted these cells as custom and then 000000 however it keeps tripping over to special Chinese (PRC)? I have no idea how to stop that!

 

[Peter_SSs]

In cells O16, O17 is 040817 and 060817

I have noticed that I have formatted these cells as custom and then 000000

You didn't give the corresponding worksheet names, but I'm guessing, for example, that you have a worksheet named '040817' and O16 is custom formatted as "00000" and shows 040817 but actually holds the value 40817 (check by selecting the cell and looking in the formula bar). If my guess is correct, the problem is that the actual cell value does not match the sheet name.

Does it help if you change this line towards the top of your code?

<del>Sheets("Compiler").Cells(rownum, 15) = Sheets(i).Name</del>
Sheets("Compiler").Cells(rownum, 15) = "'" & Sheets(i).Name

 

[gruntingmonkey]

YESSSSS!!!!!!!!! That's it. Fantastic, thank you.

Also I did quote the tab names and whatnot but it was under my code. Apologies for not making that clear.

Thanks again.

 

[Peter_SSs]

YESSSSS!!!!!!!!! That's it. Fantastic, thank you.

You are welcome.