VBA Code acts differently within dropbox

Tmini

New Member
Joined
Mar 22, 2014
Messages
41
Office Version
  1. 365
Platform
  1. Windows
Hi
I have had this persistent problem with just my personal PC at home. On all other PC's I have in my house and work PC's the code executes fine but on mine it doesn't.
What it is supposed to do is to search through a folder for excel files open each one copy the data from a sheet within those excel files and paste it into the workbook and continue down until there are no more excel files within the folder. What I have found is that instead of pasting down to the next row below the initial row it goes to paste up to the next row above the initial row but it only does this from within dropbox on my PC. If the folder containing the excel files is on the desktop then it will execute fine but if that same folder is within dropbox then it reverses the direction in which it is supposed to paste the data.
On all the other PC's I have tested from within Dropbox everything works fine. Is there something I have done wrong - I am not very good with VBA code so I may have stuffed it up and it could be broken but still works but I have no idea. - Also not a major issue and one that doesn't really bother me but if I only have one file it still executes except it comes up with an error (Run-time error '1004': AutoFill method of Range class failed) and when I hit debug it highlights x.AutoFill Destination:=Range (DesRng). This doesn't bother me so much as it still pastes the required data and I rarely ever have one single file.
If anyone could help it would be greatly appreciated thanks. Below is the entire code I run -

VBA Code:
Option Explicit
Sub RunAllMacros()
CommandButton1_Click
test
sortMyData
delrowsifzero
consolidatedata
End Sub
Sub CommandButton1_Click()
    Dim x, fldr As FileDialog, SelFold As String, i As Long
    Dim ws As Worksheet, ws1, ws2, ws3 As Worksheet
    Dim Wb As Workbook, Filename As String
    Dim screenUpdateState As String
    Dim statusBarState As String
    Dim eventsState As String
    Dim lngrow As Long
    Dim lngrow1 As Long
    
    
    
    
        
    
    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("c:\temp\cmd.exe /c Dir """ & SelFold & "\*.xls"" /s/b").stdout.readall, vbCrLf)
    
     Set ws1 = ThisWorkbook.Sheets("Labour & Material")
     Set ws2 = ThisWorkbook.Sheets("Total Hours For All Units")
     Set ws3 = ThisWorkbook.Sheets("Materials Summary")
    
    '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 lngrow1 = 0 Then
        lngrow1 = 5
    Else
        lngrow1 = lngrow1 + 1
        lngrow = lngrow + 275
    End If
        ws1.Cells(lngrow1, "A").Value = ws.Range("A1").Value
        ws1.Cells(lngrow1, "B").Value = ws.Range("I2").Value
        ws1.Cells(lngrow1, "C").Value = ws.Range("C2").Value
        ws1.Cells(lngrow1, "E").Value = ws.Range("C3").Value
        ws1.Cells(lngrow1, "G").Value = ws.Range("C4").Value
        ws2.Cells(lngrow1, "B").Value = ws.Range("B8").Value
        ws2.Cells(lngrow1, "C").Value = ws.Range("B9").Value
        ws2.Cells(lngrow1, "D").Value = ws.Range("B10").Value
        ws2.Cells(lngrow1, "E").Value = ws.Range("B11").Value
        ws2.Cells(lngrow1, "F").Value = ws.Range("B12").Value
        ws2.Cells(lngrow1, "G").Value = ws.Range("B13").Value
        ws2.Cells(lngrow1, "H").Value = ws.Range("B14").Value
        ws3.Range("A2:A228").Offset(lngrow, 0).Value = ws.Range("A16:A242").Value
        ws3.Range("B2:B228").Offset(lngrow, 0).Value = ws.Range("C16:C242").Value
        ws3.Range("E2:E228").Offset(lngrow, 0).Value = ws.Range("H16:H242").Value
        ws3.Range("D2:D228").Offset(lngrow, 0).Value = ws.Range("E16:E242").Value
        ws3.Range("F2:F228").Offset(lngrow, 0).Value = ws.Range("F16:F242").Value
          ws3.Range("A229:A275").Offset(lngrow, 0).Value = ws.Range("I16:I62").Value
        ws3.Range("b229:b275").Offset(lngrow, 0).Value = ws.Range("J16:J62").Value
        ws3.Range("d229:d275").Offset(lngrow, 0).Value = ws.Range("K16:K62").Value
        ws3.Range("e229:e275").Offset(lngrow, 0).Value = ws.Range("l16:l62").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(2, 3, 6, 8)
For Each Sh In Sheets(SheetNum)
    Sh.Select
    Set SoRng = Sh.Range("A5", Sh.Range("A5").End(xlToRight).Address)
    AdvFil SoRng
Next

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

Sheets(5).Select
Set SoRng = Sheets(5).Range("i5:q5")
AdvFil SoRng

Sheets(4).Select
ColNo = Array("D", "F", "H")
    For Each Col In ColNo
    Set SoRng = Sheets(4).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(4).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
Sub sortMyData()

Dim LastRow As Long
Dim myRng As Range

With ActiveWorkbook.Worksheets("Materials Summary")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = .Range("a1:f" & LastRow)
myRng.Sort Key1:=.Columns(1), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

End With

End Sub
Sub delrowsifzero()
    Application.ScreenUpdating = False
    Dim LastRow As Long
     Worksheets("Materials Summary").Activate
     On Error Resume Next
       LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long
    ActiveWorkbook.Worksheets("Materials Summary").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Materials Summary").Sort.SortFields.Add Key:=Range("A2:f" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Materials Summary").Sort
        .SetRange Range("A:f" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    For x = LastRow To 2 Step -1
        If Cells(x, 2) = "" Or Cells(x, 2) = 0 Then
            Rows(x).EntireRow.Delete
        End If
    Next x
    Application.ScreenUpdating = True
      End Sub
      Sub consolidatedata()
    Worksheets("Materials Summary").Range("h2").Consolidate _
    Sources:=Array("Materials Summary!data"), _
    Function:=xlSum, LeftColumn:=True
    Sheets("Overall Summary").Select
End Sub

If more information is needed or I need to upload example files let me know and I'll do what I can
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
It doesn't look like you're going to get much help with your question posed as it is.

Asking for help
Your code is hard to read, it's not spaced out well, there's little indentation in the section you're requesting help with and you have multiple macros all over the place.

I'm not sure if you're using this as your entry point.
VBA Code:
Sub RunAllMacros()
CommandButton1_Click
test
sortMyData
delrowsifzero
consolidatedata
End Sub

Or if this is your entry point
VBA Code:
Sub CommandButton1_Click()

There's a lot of relative clauses that will only make sense watching the code run in context and that's a effort I'd have to put in to make fake data and psuedo step through it to try to approximate what you're trying to do. I'm not sure if the forum allows it but I'd either upload the workbook or significantly cut down the code to give us a contrived example so we can focus on a single part of the code that is causing you issues and trouble shoot that specifically. Right now it's quite intimidating.

eg, My car is broken! Here's a picture of my engine bay.

versus

My engine is turning over, I have clean fuel at the injectors, I've cleaned the air filter and my spark plugs have been replaced. Why won't my engine start?

Debugging
One thing I can suggest is you use the breakpoints. Click the gray bar on the left of the developer console and put in a break point where your code is selecting the row that is messing up. If you're unsure, put in break points everywhere.
when you find the issue of the program heading in the wrong direction check your Locals window for the variable controlling that index and work backwards.
As you are stepping through code, you'll notice that the next line to execute is highlighted in yellow, and has a yellow arrow pointing to it in the margin.
You can use your mouse to drag this arrow to whatever line you want in the same sub (provided it's an executable line), and execution will then continue from there.
What logic caused it to decrement instead of increment?
By going through the locals windows and watching the variables as you step through the code you will probably find something that isn't supposed to be happening.
In the rare case it's a DropBox related issue, maybe you can notice it and code a work around.

https://www.myonlinetraininghub.com/debugging-vba-code
VBA: How to Debug Code
VBA – Debug.Print and the Immediate Window - Automate Excel

Error handling
As for your issue where AdvFil breaks on a single file. If you're happy for it to break on a single file you can use some basic error handling to silently handle (or not handle) the error.

Use this when you don't need to use any error handler labels and you're going to handle the error for that particular statement or section of statements. You might combine this with code to detect the error to know how to proceed.
VBA Code:
    On Error Resume Next 
    Set ws = Sheets(wsName) 'sometimes the sheet won't have a name, skip this line if we can't set the worksheet

On Error statement (VBA)
Error Handling In VBA

Hope that helps. Goodluck (y)
 
Upvote 0

Forum statistics

Threads
1,214,985
Messages
6,122,606
Members
449,089
Latest member
Motoracer88

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