Excel Crashing 1 out of 5 times

K

knacksc2

Board Regular
Joined
Jan 23, 2014
Messages
63
Hello all,

I am still very new to VBA and am probably making terrible mistakes in the below code, but am willing to learn. So this is pulling some summary numbers from reports that are generated on a per facility basis. All the reports are named the same thing, but are in separate locations. Takes those and turns it into basically one digestible report. The macro takes over a minute to run and occasionally excel will begin to not respond and restart. That would be fine for me, but i want an executive in the company to be able to use this with no troubles. Can you help me make this code unbreakable. the only error i have ever seen is that there is not enough room in the clipboard, runtime error 1004. but that only once, the other times no indication of what is wrong. here is the code:

Code: 
Sub Create_Sheet()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "Single Branch Open Order Sum"
    
    Dim ws2 As Worksheet
    Set ws2 = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws2.Name = "Single Branch Open Ord SLSRGN"
End Sub
Sub Delete_Sheet()
Application.DisplayAlerts = False
    Sheets("Single Branch Open Order Sum").Delete
    Sheets("Single Branch Open Ord SLSRGN").Delete
Application.DisplayAlerts = True
ActiveWorkbook.Save
End Sub
Sub Import_Both()


Application.ScreenUpdating = False
Application.Calculation = False


UserForm1.Show (vbModeless)
UserForm1.Repaint


Sheet1.Cells(2, 6).Value = Now()






Dim axa As Integer
axa = Sheet1.Cells(5, 3).Value


For bxb = 1 To axa


    '''''Define Object for Target Workbook
    Dim Target_Workbook As Workbook
    Dim Source_Workbook As Workbook
    Dim Target_Path As String
    Dim File_Name As String
    Dim File_Name2 As String
    
    File_Name = "Open Order Summary.XLSX"
    File_Name2 = "Open Order Summary SLSRGN.XLSX"
    Target_Path = Sheet1.Cells(6 + bxb, 34).Value & "\" & File_Name
    Target_Path2 = Sheet1.Cells(6 + bxb, 34).Value & "\" & File_Name2
        '''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim Check_Target_Path As String
        Check_Target_Path = Target_Path
        If Dir(Check_Target_Path) = "" Then
        GoTo DoNothingForThisBranch
        Else
        End If
        '''''''''''''''''''''''''''''''''''''''''''''''''''''
    Set Target_Workbook = Workbooks.Open(Target_Path)
    Set Target_Workbook = Workbooks.Open(Target_Path2)
    Set Source_Workbook = ThisWorkbook


ThisWorkbook.Activate
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells.ClearContents


Workbooks(File_Name).Activate


Dim count1
count1 = Application.WorksheetFunction.CountA(Workbooks(File_Name).Worksheets(1).Range(Cells(2, 8), Cells(1040000, 8)))


Workbooks(File_Name).Sheets(1).Range(Cells(1, 1), Cells(1 + count1, 43)).Select
Selection.Copy


ThisWorkbook.Activate
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Select
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False


Workbooks(File_Name2).Activate


Dim count2
count2 = Application.WorksheetFunction.CountA(Workbooks(File_Name2).Worksheets(1).Range(Cells(2, 8), Cells(1040000, 8)))


Workbooks(File_Name2).Sheets(1).Range(Cells(1, 1), Cells(1 + count2, 43)).Select
Selection.Copy


ThisWorkbook.Activate
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Select
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False


Workbooks(File_Name).Close
Workbooks(File_Name2).Close


'********  clear out the old data for the branch
ActiveWorkbook.Worksheets("Entire Open Order Dash").Select
ActiveWorkbook.Worksheets("Entire Open Order Dash").Range(Cells(6 + bxb, 3), Cells(6 + bxb, 33)).Select
Selection.ClearContents


Dim w, x, y, z As Integer
w = Sheet1.Cells(5, 26).Value
x = Sheet1.Cells(5, 28).Value
y = Sheet1.Cells(5, 30).Value
z = Sheet1.Cells(5, 32).Value


'**** calculate actual late in days
    For b = 1 To count1
    
    '**** Summary
    ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 1).Value = (DateValue(DateSerial(Year(Now()), Month(Now()), Day(Now())))) - (DateValue(DateSerial(Year(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 13).Value), Month(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 13).Value), Day(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 13).Value))))
    
    If ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 1).Value > w Then
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 26).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 26).Value + 1
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 26).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 26).Value + ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 16).Value
    Else
    End If
    If ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 1).Value > x Then
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 28).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 28).Value + 1
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 28).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 28).Value + ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 16).Value
    Else
    End If
    If ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 1).Value > y Then
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 30).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 30).Value + 1
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 30).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 30).Value + ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 16).Value
    Else
    End If
    If ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 1).Value > z Then
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 32).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 32).Value + 1
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 32).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 32).Value + ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 16).Value
    Else
    End If
    
    '~*~* Force the max of Value and Balance into Value Column
    ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 3).Value = Application.WorksheetFunction.Max(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 3).Value, ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1 + b, 16).Value)
    
    Next b
    
    For c = 1 To count2
            
    '~~~~ SLSRGN
    ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 1).Value = (DateValue(DateSerial(Year(Now()), Month(Now()), Day(Now())))) - (DateValue(DateSerial(Year(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 13).Value), Month(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 13).Value), Day(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 13).Value))))
    
    If ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 1).Value > w Then
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 26).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 26).Value + 1
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 26).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 26).Value + ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 16).Value
    Else
    End If
    If ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 1).Value > x Then
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 28).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 28).Value + 1
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 28).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 28).Value + ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 16).Value
    Else
    End If
    If ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 1).Value > y Then
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 30).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 30).Value + 1
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 30).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 30).Value + ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 16).Value
    Else
    End If
    If ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 1).Value > z Then
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 32).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 32).Value + 1
    ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 32).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 32).Value + ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 16).Value
    Else
    End If
    
    '~*~* Force the max of Value and Balance into Value Column
    ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 3).Value = Application.WorksheetFunction.Max(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 3).Value, ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1 + c, 16).Value)
    
    Next c


'~*~* Count orders over 24 mo. old
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 26).Value = (ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 26).Value + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 26).Value)
'~*~* Count orders 18-24 mo. old
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 28).Value = (ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 28).Value + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 28).Value) - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 26).Value
'~*~* Count orders 12-18 mo. old
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 30).Value = (ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 30).Value + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 30).Value) - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 28).Value - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 26).Value
'~*~* Count orders 6-12 mo. old
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 32).Value = (ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(3, 32).Value + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 32).Value) - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 30).Value - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 28).Value - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 26).Value
'~*~* Count orders over 24 mo. old
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 27).Value = (ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 26).Value + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 26).Value)
'~*~* Count orders 18-24 mo. old
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 29).Value = (ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 28).Value + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 28).Value) - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 27).Value
'~*~* Count orders 12-18 mo. old
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 31).Value = (ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 30).Value + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 30).Value) - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 29).Value - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 27).Value
'~*~* Count orders 6-12 mo. old
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 33).Value = (ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(2, 32).Value + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(4, 32).Value) - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 31).Value - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 29).Value - ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 27).Value
For k = 1 To 8
If ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 25 + k).Value = 0 Then
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 25 + k).Value = ""
Else
End If
Next k


ActiveWorkbook.Worksheets("Entire Open Order Dash").Range(Cells(1, 26), Cells(4, 26)).Select
Selection.ClearContents
ActiveWorkbook.Worksheets("Entire Open Order Dash").Range(Cells(1, 28), Cells(4, 28)).Select
Selection.ClearContents
ActiveWorkbook.Worksheets("Entire Open Order Dash").Range(Cells(1, 30), Cells(4, 30)).Select
Selection.ClearContents
ActiveWorkbook.Worksheets("Entire Open Order Dash").Range(Cells(1, 32), Cells(4, 32)).Select
Selection.ClearContents




'**** Sort Summary by late
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Select
Range("A2:AG20000").Select
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Sort.SortFields. _
    Clear
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Sort.SortFields. _
    Add Key:=Range("B2:B20000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
    DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Sort
    .SetRange Range("A2:AG20000")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


'~~~~ Sort SLSRGN by late
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Select
Range("A2:AH20000").Select
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Sort.SortFields. _
    Clear
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Sort.SortFields. _
    Add Key:=Range("B2:B20000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
    DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Sort
    .SetRange Range("A2:AH20000")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


'**** Calculate total orders that are late
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Select
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 11).Value = Application.WorksheetFunction.CountIf(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Range(Cells(2, 2), Cells(20000, 2)), "<.5")


'**** Calculate dollar volume B/O of late orders
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 12).Value = Application.WorksheetFunction.Sum(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Range(Cells(2, 16), Cells(1 + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 11).Value, 16)))


'~~~~ Calculate total orders that are late
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Select
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 20).Value = Application.WorksheetFunction.CountIf(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Range(Cells(2, 2), Cells(20000, 2)), "<.5")


'~~~~ Calculate dollar volume B/O of late orders
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 21).Value = Application.WorksheetFunction.Sum(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Range(Cells(2, 16), Cells(1 + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 20).Value, 16)))


'~*~* Calculate Stats
'~*~* Late Avg Age
Dim j1
j1 = Application.WorksheetFunction.Sum(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Range(Cells(2, 1), Cells(1 + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 20).Value, 1)))
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Select
Dim i1
i1 = Application.WorksheetFunction.Sum(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Range(Cells(2, 1), Cells(1 + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 11).Value, 1)))
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 24).Value = (i1 + j1) / (ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 11).Value + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 20).Value)




'**** Sort Summary by age
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Select
Range("A2:AG20000").Select
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Sort.SortFields. _
    Clear
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Sort.SortFields. _
    Add Key:=Range("A2:A20000"), SortOn:=xlSortOnValues, Order:=xlDescending, _
    DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Sort
    .SetRange Range("A2:AG20000")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


'~~~~ Sort SLSRGN by age
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Select
Range("A2:AH20000").Select
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Sort.SortFields. _
    Clear
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Sort.SortFields. _
    Add Key:=Range("A2:A20000"), SortOn:=xlSortOnValues, Order:=xlDescending, _
    DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Sort
    .SetRange Range("A2:AH20000")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With




'**** Calculate total orders on Summary
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Select
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 5).Value = Application.WorksheetFunction.CountA(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Range(Cells(2, 1), Cells(20000, 1)))


'**** Calculate total dollar volume on Summary
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 6).Value = Application.WorksheetFunction.Sum(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Range(Cells(2, 3), Cells(20000, 3)))


'**** Calculate total orders with backorder qty
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 8).Value = Application.WorksheetFunction.CountIf(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Range(Cells(2, 16), Cells(20000, 16)), ">0")


'**** Calculate total dollar volume B/O on Summary
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 9).Value = Application.WorksheetFunction.Sum(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Range(Cells(2, 16), Cells(20000, 16)))


'~~~~ Calculate total orders on Summary
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Select
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 14).Value = Application.WorksheetFunction.CountA(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Range(Cells(2, 1), Cells(20000, 1)))


'~~~~ Calculate total dollar volume on Summary
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 15).Value = Application.WorksheetFunction.Sum(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Range(Cells(2, 3), Cells(20000, 3)))


'~~~~ Calculate total orders with backorder qty
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 17).Value = Application.WorksheetFunction.CountIf(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Range(Cells(2, 16), Cells(20000, 16)), ">0")


'~~~~ Calculate total dollar volume B/O on Summary
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 18).Value = Application.WorksheetFunction.Sum(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Range(Cells(2, 16), Cells(20000, 16)))


'~*~* Calculate Entire Open Orders
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 3).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 5).Value + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 14).Value


'~*~* Calculate Entire Open Orders Dollar Volume
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 4).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 6).Value + ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 15).Value


'**** Calculate Percentages
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 7).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 6).Value / ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 4).Value
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 10).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 9).Value / ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 4).Value
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 13).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 12).Value / ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 4).Value


'~~~~ Calculate Percentages
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 16).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 15).Value / ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 4).Value
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 19).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 18).Value / ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 4).Value
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 22).Value = ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 21).Value / ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 4).Value


'~*~* Calculate Stats
'~*~* Total Open Avg Age
Dim j
j = Application.WorksheetFunction.Sum(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Range(Cells(2, 1), Cells(20000, 1)))
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Select
Dim i
i = Application.WorksheetFunction.Sum(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Range(Cells(2, 1), Cells(20000, 1)))
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 23).Value = (i + j) / ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 3).Value


'~*~* Calculate Max Age
Dim i2
i2 = Application.WorksheetFunction.Max(ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Range(Cells(2, 1), Cells(20000, 1)))
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Select
Dim j2
j2 = Application.WorksheetFunction.Max(ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Range(Cells(2, 1), Cells(20000, 1)))
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(6 + bxb, 25).Value = Application.WorksheetFunction.Max(i2, j2)


ActiveWorkbook.Worksheets("Entire Open Order Dash").Select
ActiveWorkbook.Worksheets("Entire Open Order Dash").Cells(1, 1).Select




DoNothingForThisBranch:


ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Select
ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Range(Cells(1, 1), Cells(1 + count1, 43)).Select
Selection.ClearContents
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Select
ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Range(Cells(1, 1), Cells(1 + count2, 43)).Select
Selection.ClearContents


Next bxb


Sheet1.Select
Sheet1.Cells(4, 27).Value = Application.WorksheetFunction.Sum(Sheet1.Range(Cells(7, 27), Cells(45, 27)))
Sheet1.Select
Sheet1.Cells(4, 29).Value = Application.WorksheetFunction.Sum(Sheet1.Range(Cells(7, 29), Cells(45, 29)))
Sheet1.Select
Sheet1.Cells(4, 31).Value = Application.WorksheetFunction.Sum(Sheet1.Range(Cells(7, 31), Cells(45, 31)))
Sheet1.Select
Sheet1.Cells(4, 33).Value = Application.WorksheetFunction.Sum(Sheet1.Range(Cells(7, 33), Cells(45, 33)))


UserForm1.Hide
UserForm1.Repaint


Application.ScreenUpdating = True
Application.Calculation = True


End Sub
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
Sounds like your clipboard is overfilling and randomly crashing. Trial this...
Place this code in a module...
Code: 
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Here is the relevant section of your code to change...
Code: 
Workbooks(File_Name).Activate
Dim count1
count1 = Application.WorksheetFunction.CountA(Workbooks(File_Name).Worksheets(1).Range(Cells(2, 8), Cells(1040000, 8)))
'Workbooks(File_Name).Sheets(1).Range(Cells(1, 1), Cells(1 + count1, 43)).Select
'Selection.Copy
'ThisWorkbook.Activate
'ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Select
'ActiveWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1, 1).Select
'ActiveSheet.Paste
'Application.CutCopyMode = False
Workbooks(File_Name).Sheets(1).Range(Cells(1, 1), Cells(1 + count1, 43)).Copy _
    Destination:=ThisWorkbook.Worksheets("Single Branch Open Order Sum").Cells(1, 1)
Application.CutCopyMode = False
OpenClipboard (0&)
EmptyClipboard
CloseClipboard

Workbooks(File_Name2).Activate
Dim count2
count2 = Application.WorksheetFunction.CountA(Workbooks(File_Name2).Worksheets(1).Range(Cells(2, 8), Cells(1040000, 8)))
'Workbooks(File_Name2).Sheets(1).Range(Cells(1, 1), Cells(1 + count2, 43)).Select
'Selection.Copy
'ThisWorkbook.Activate
'ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Select
'ActiveWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1, 1).Select
'ActiveSheet.Paste
'Application.CutCopyMode = False
Workbooks(File_Name2).Sheets(1).Range(Cells(1, 1), Cells(1 + count2, 43)).Copy _
    Destination:=ThisWorkbook.Worksheets("Single Branch Open Ord SLSRGN").Cells(1, 1)
Application.CutCopyMode = False
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
The use of Selection is rarely required and slows down your code execution. An example from your code...
Code: 
'********  clear out the old data for the branch
'ActiveWorkbook.Worksheets("Entire Open Order Dash").Select
'ActiveWorkbook.Worksheets("Entire Open Order Dash").Range(Cells(6 + bxb, 3), Cells(6 + bxb, 33)).Select
'Selection.ClearContents
ActiveWorkbook.Worksheets("Entire Open Order Dash").Range(Cells(6 + bxb, 3), Cells(6 + bxb, 33)).ClearContents
I would also encourage the use of...
Code: 
Option Explicit
at the top of your sheet code.
HTH. Dave
 
Upvote 0
Wow, a lot for me to learn. I am so grateful. option explicit is something i am unfamiliar with, looking forward to implementing.
 
Upvote 0
Thanks for posting your outcome. Option Explicit forces U to declare all of your variables which will prevent confusing code execution errors. Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
Optimising my VBA to improve the efficiency of my Workbook
2 3
Replies
21
Views
2K
Tmini
T
S
  • Question Question
Macro for
Replies
2
Views
96
Sanderb
S
H
  • Question Question
Macro: Convert pdf into Excel and extract certain data to put together with file name
Replies
1
Views
3K
HeinrichPaul
H
hendrikbez
  • Question Question
Cannot get to edit on my user form with 1 to 5 members on it
Replies
1
Views
264
Anthony47
A
R
  • Question Question
Highlighting cells based on criteria
Replies
0
Views
418
rahildhody
R

Forum statistics

Threads
1,223,896
Messages
6,175,260
Members
452,627
Latest member
KitkatToby

Share this page

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