Worksheet with VBA coding works in 2010/2013 but not 2016

Tmini

New Member
Joined
Mar 22, 2014
Messages
44
Office Version
  1. 365
Platform
  1. Windows
Hi
I have a workbook which pulls data from a number of closed workbooks in a folder and collates all of that information and makes it so I can quickly and easily summarise data in a single sheet from hundreds of workbooks. I have subscribed to the office 365 suite and the workbook doesn't work with excel 2016. It comes up with a message saying that it won't work because the workbook is protected but I even turned off all protection settings on all of the sheets and it tries to work but it doesn't seem to place the data correctly and just stops without an error. Does anyone have any idea of what it could be that could be occurring?

This file is the workbook which contains the information I wish to extract. I quite often have hundreds of these in a folder containing all of the data I need to produce the figures I want https://www.dropbox.com/s/g3dlvusrh36bxze/01 QUOTE LIST TEMPLATE ALL UNITS V3.5.xlsx?dl=0. This file contains no VBA coding

This file is the workbook which I use to extract the data from all of my closed workbooks https://www.dropbox.com/s/dalm3csd0uw4x3y/02 PROFIT WORKINGS V1.7.xlsm?dl=0 this file contains all of the VBA coding in which I use to automate the process of opening and closing the closed workbooks within a folder and copying all of the data required.

The VBA code in question

Code:
Sub RunAllMacros()CommandButton1_Click
test
End Sub
Sub CommandButton1_Click()
    Dim x, fldr As FileDialog, SelFold As String, i As Long
    Dim ws As Worksheet, ws1 As Worksheet
    Dim Wb As Workbook, Filename As String
    
    screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
eventsState = Application.EnableEvents


'turn off some Excel functionality for faster performance
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False




    'User Selects desired Folder
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        If .Show <> -1 Then GoTo Cleanup
        SelFold = .SelectedItems(1)
    End With


    'All .xls* files in Selected FolderPath including Sub folders are put into an array
    x = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & SelFold & "\*.xls"" /s/b").stdout.readall, vbCrLf)
     
     Set ws1 = ThisWorkbook.Sheets("Labour & Material")
     Set ws2 = ThisWorkbook.Sheets("Total Hours For All Units")
     
    'Loop through that array
    For i = LBound(x) To UBound(x) - 1


    'Open (in background) the Workbook
        With GetObject(x(i))
           
            ThisWorkbook.Sheets(1).UsedRange
            Filename = Split(x(i), "\")(UBound(Split(x(i), "\")))
       Set Wb = Workbooks(Filename)
        Set ws = Nothing
        On Error Resume Next
        'change sheet name here
        Set ws = Wb.Sheets("Total Quantities")
        On Error GoTo 0
        If Not ws Is Nothing Then
        If lngrow = 0 Then
        lngrow = 5
    Else
        lngrow = lngrow + 1
    End If
        ws1.Cells(lngrow, "A").Value = ws.Range("A1").Value
        ws1.Cells(lngrow, "B").Value = ws.Range("I2").Value
        ws1.Cells(lngrow, "C").Value = ws.Range("C2").Value
        ws1.Cells(lngrow, "E").Value = ws.Range("C3").Value
        ws1.Cells(lngrow, "G").Value = ws.Range("C4").Value
        ws2.Cells(lngrow, "B").Value = ws.Range("B8").Value
        ws2.Cells(lngrow, "C").Value = ws.Range("B9").Value
        ws2.Cells(lngrow, "D").Value = ws.Range("B10").Value
        ws2.Cells(lngrow, "E").Value = ws.Range("B11").Value
        ws2.Cells(lngrow, "F").Value = ws.Range("B12").Value
        ws2.Cells(lngrow, "G").Value = ws.Range("B13").Value
        End If
            .Close
        End With
    Next i


Cleanup:
    Set fldr = Nothing
End Sub
Sub test()
SheetNum = Array(1, 2, 5, 6)
For Each Sh In Sheets(SheetNum)
    Sh.Select
    Set SoRng = Sh.Range("A5", Sh.Range("A5").End(xlToRight).Address)
    AdvFil SoRng
Next


Sheets(4).Select
Set SoRng = Sheets(4).Range("A5:A5")
AdvFil SoRng


Sheets(3).Select
ColNo = Array("D", "F", "H")
    For Each Col In ColNo
    Set SoRng = Sheets(3).Range(Col & "5:" & Col & "5")
    AdvFil SoRng
Next


End Sub
Sub AdvFil(ByVal x As Range)
LrNum = Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row
If InStr(1, x.Address, ":") > 0 Then
    DesRng = Left(x.Address, Len(x.Address) - 1) & LrNum
Else
    DesRng = x.Address & ":" & Left(x.Address, Len(x.Address) - 1) & LrNum
End If
x.AutoFill Destination:=Range(DesRng)
End Sub

I hope I have explained myself well enough for someone to understand what I am trying to do and what my problem is. i probably have stuffed up with the VBA coding as I am not terribly proficient with VBA
 
Last edited:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Ok so digging about I have read that 32 bit and 64 bit versions may not work properly together. The version I created the workbooks on are 32 bit excel 2010 and the versions that have worked previously was 2013 64 bit but it doesn't want to work on 2016 64 bit. Could this be my issue and if it is what is the solution to fix it? I don't understand how that could be my problem.
I use 2010 on my computer at work but I use 2016 on my computer at home. Eventually I want to upgrade to 2016 but I don't want to upgrade if I can't get all of my macros working correctly. I just lack the understanding of where my problem is arising
 
Upvote 0
Well I haven't received any responses so I am guessing my problem is not really well explained. Since yesterday though I have altered the code and defined variables etc which appeared to have worked - it has stopped compile errors now.

The problem I have now is when I run it in excel 2016 it goes through to select the folder containing all of my excel files just fine and then it acts like it is doing something and then nothing. No error nothing it doesn't extract any data or anything. When i run it in excel 2010 it works perfectly. It extracts the data and does exactly as I require it.

The follwoing link is the folder which contains my spreadsheet and it also contains a test folder from which the data should be extracted from, if this helps or is of any use to anyone.
https://www.dropbox.com/sh/oevir4z9w6u3ga5/AAC-LEiWZVES0hk-adTF51ONa?dl=0

I would really appreciate any help on this as I am sure we will be upgrading to 2016 excel fairly soon and I am relying on this to be working. I am just unsure where to go from here. If I have too much information or not enough just let me know and I'll try and rephrase what I am asking, it's just a bit hard when no errors are being thrown out.

Code:
Option ExplicitSub RunAllMacros()
CommandButton1_Click
test
End Sub
Sub CommandButton1_Click()
    Dim x, fldr As FileDialog, SelFold As String, i As Long
    Dim ws As Worksheet, ws1, ws2 As Worksheet
    Dim Wb As Workbook, Filename As String
    Dim screenUpdateState As String
    Dim statusBarState As String
    Dim eventsState As String
    Dim lngrow As Integer
    
    
    
    
        
    
    screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
eventsState = Application.EnableEvents


'turn off some Excel functionality for faster performance
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False




    'User Selects desired Folder
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        If .Show <> -1 Then GoTo Cleanup
        SelFold = .SelectedItems(1)
    End With


    'All .xls* files in Selected FolderPath including Sub folders are put into an array
    x = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & SelFold & "\*.xls"" /s/b").stdout.readall, vbCrLf)
     
     Set ws1 = ThisWorkbook.Sheets("Labour & Material")
     Set ws2 = ThisWorkbook.Sheets("Total Hours For All Units")
     
    'Loop through that array
    For i = LBound(x) To UBound(x) - 1


    'Open (in background) the Workbook
        With GetObject(x(i))
           
            ThisWorkbook.Sheets(1).UsedRange
            Filename = Split(x(i), "\")(UBound(Split(x(i), "\")))
       Set Wb = Workbooks(Filename)
        Set ws = Nothing
        On Error Resume Next
        'change sheet name here
        Set ws = Wb.Sheets("Total Quantities")
        On Error GoTo 0
        If Not ws Is Nothing Then
        If lngrow = 0 Then
        lngrow = 5
    Else
        lngrow = lngrow + 1
    End If
        ws1.Cells(lngrow, "A").Value = ws.Range("A1").Value
        ws1.Cells(lngrow, "B").Value = ws.Range("I2").Value
        ws1.Cells(lngrow, "C").Value = ws.Range("C2").Value
        ws1.Cells(lngrow, "E").Value = ws.Range("C3").Value
        ws1.Cells(lngrow, "G").Value = ws.Range("C4").Value
        ws2.Cells(lngrow, "B").Value = ws.Range("B8").Value
        ws2.Cells(lngrow, "C").Value = ws.Range("B9").Value
        ws2.Cells(lngrow, "D").Value = ws.Range("B10").Value
        ws2.Cells(lngrow, "E").Value = ws.Range("B11").Value
        ws2.Cells(lngrow, "F").Value = ws.Range("B12").Value
        ws2.Cells(lngrow, "G").Value = ws.Range("B13").Value
        End If
            .Close
        End With
    Next i


Cleanup:
    Set fldr = Nothing
End Sub
Sub test()
Dim SheetNum As Variant
Dim Sh As Variant
Dim SoRng As Variant
Dim ColNo As Variant
Dim Col As Variant






SheetNum = Array(1, 2, 5, 6)
For Each Sh In Sheets(SheetNum)
    Sh.Select
    Set SoRng = Sh.Range("A5", Sh.Range("A5").End(xlToRight).Address)
    AdvFil SoRng
Next


Sheets(4).Select
Set SoRng = Sheets(4).Range("A5:A5")
AdvFil SoRng


Sheets(3).Select
ColNo = Array("D", "F", "H")
    For Each Col In ColNo
    Set SoRng = Sheets(3).Range(Col & "5:" & Col & "5")
    AdvFil SoRng
Next


End Sub
Sub AdvFil(ByVal x As Range)
Dim LrNum As String
Dim DesRng As Variant


LrNum = Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row
If InStr(1, x.Address, ":") > 0 Then
    DesRng = Left(x.Address, Len(x.Address) - 1) & LrNum
Else
    DesRng = x.Address & ":" & Left(x.Address, Len(x.Address) - 1) & LrNum
End If
x.AutoFill Destination:=Range(DesRng)
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,959
Messages
6,175,647
Members
452,663
Latest member
MEMEH

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
Back
Top