Posts by JonathanVH

I just used that as a proof of concept. Where do you want your results? If you want then on the same sheet as the data, but in columns to the right, then you could use something like:

With ActiveSheet.Range("M1")

If you want them on a the second sheet (and there is a second sheet in the workbook), you could change that to something like this:

With ActiveWorkbook.Worksheets(2).Range("M1")

This all assumes (as does the former use of ActiveWorkbook) that the workbook with the data is active when the macro is run.

Sure. Just change the line With ThisWorkbook to With ActiveWorkbook. You also might want to add another line there to save the workbook.

If the headers are created by the "data dump," then change the VBA (SQL) code rather than trimming the values each time the data comes over. E.g., If a heading has "Branch " (with a space as the last character), then change the SQL code to match that:

sql = "SELECT [Branch ], [Item Number], MIN([Start Date]) As [Date Negative], '' As [Month], MIN([Available Quantity]) As [Max Qty Negative] " & _
        "FROM [Sheet1$] " & _
        "WHERE [Available Quantity] < 0 " & _
        "GROUP BY [Branch ], MONTH([Start Date]), [Item Number];"

Revised for headers:

Sub SummaryRept()
Dim aCn As Object, aRs As Object, d As String, sql As String, f As Long
  Set aCn = CreateObject("ADODB.Connection")
  Set aRs = CreateObject("ADODB.Recordset")
  With ThisWorkbook
    d = .Path & "\" & .Name
  End With
  With aCn
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & d & "';Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"
    .Open
  End With
  sql = "SELECT Branch, [Item Number], MIN([Start Date]) As [Date Negative], '' As [Month], MIN([Available Quantity]) As [Max Qty Negative] " & _
        "FROM [Sheet1$] " & _
        "WHERE [Available Quantity] < 0 " & _
        "GROUP BY Branch, MONTH([Start Date]), [Item Number];"
  aRs.Open sql, aCn, 3, 1, 1


  With Sheet2.Range("A1")
    For f = 1 To aRs.Fields.Count
      .Cells(1, f) = aRs.Fields(f - 1).Name
    Next
    .Offset(1).Resize(aRs.RecordCount, aRs.Fields.Count).CopyFromRecordset aRs
    .Offset(1, 3).Resize(aRs.RecordCount).FormulaR1C1 = "=TEXT(RC[-1],""mmmm"")"
    .Offset(1, 4).Resize(aRs.RecordCount).NumberFormat = "General"
  End With
  aCn.Close
  Set aCn = Nothing
  Set aRs = Nothing
End Sub

What does the top row (header) of your data range look like, exactly? In your above sample, it has "Branch", Item Number", "Buyer", "QTY", "Type", "Start", "Available", "LT", and "Stock." If those aren't the actual headers, then the SELECT statement will need to be changed to reflect what you actually have there. Perhaps it instead should be:

sql = "SELECT Branch, [Item Number], MIN([Start Date]) As [Date Negative], '' As [Month], MIN([Available Quantity]) As [Max Qty Negative] " & _
        "FROM [Sheet1$] " & _
        "WHERE [Available Quantity] < 0 " & _
        "GROUP BY Branch, MONTH([Start Date]), [Item Number];"

Assuming the "save bit" is a range(cell), on an Excel worksheet, how does that get changed from 0 to 1? I.e., does the user select the cell and change it, or is the value there when the file is opened?

I googled the error and it can be caused by changing the data being selected and not saving the changes. So try saving the workbook after downloading the data, and then running the subroutine. As you can see, it uses the file (variable d), rather than the (open) workbook. (This is a nice feature because it works without opening workbooks.)

That probably means an issue with the connection string, most likely the driver, but it could also be the file name (d). Are you running 64-bit Office by any chance?

Is a line of code highlighted after that error is thrown?

You may need to download the ACE driver.

Something like this?

Sub AutomatedGraph()
Dim StartRng As Range, xRng As Range, n As Long
  ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmooth).Select
  ActiveSheet.Shapes("Chart 2").IncrementLeft 202.5
  ActiveSheet.Shapes("Chart 2").IncrementTop -163.9285826772
  With Worksheets("Data")
    Set xRng = .Range("$A$24:$A$31")
    Set StartRng = .Range("$Y$24:$Y$31")
  End With
  With ActiveChart
    For n = 0 To 14
      .SeriesCollection.NewSeries
      With .FullSeriesCollection(n + 1)
        .XValues = "=Data!" & xRng.Address
        .Values = "=Data!" & StartRng.Offset(, n).Address
        .Name = "=Data!" & StartRng(0, n + 1).Address
      End With
    Next
  End With
End Sub

You need to create the string using the variable contenets, not the vaiable name, e.g.:

ActiveWorkbook.Names.Add Name:=RSource, RefersTo:="=OFFSET('" & SheetName & "'!$A$6,0,0,COUNTA('" & SheetName & "'!$A:$A),1)"

To modularise that, create an event handler class for the text boxes with max and min properties for the allowed key code ranges. Instantiate a class object for each relevant control in the form's Initialize event and keep them in a collection.

Throwing up message boxes will probably annoy users, so instead consider using a Beep statement and, perhaps, some prompting labels on the form. E.g., for the class event:

Private Sub m_oTextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  If KeyAscii < Me.MinKey Or KeyAscii > Me.MaxKey Then
    KeyAscii = 0
    Beep
  End If
End Sub

You're declaring a constant SheetToCopy as a variant containing the string "A1" (so therefore a VarType of vbString). Unless you have a sheet named A1, your i variable will be its initial value of zero. Why not instead declare a string variable for the sheet name and assign it from the value in the A1 cell?

That wouldn't be conditional formatting. If, when you write "selected," you mean someone clicks on the cell, then you will need to use the Worksheet's Selection Change event, e.g.,

Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("C4")) Is Nothing Then
    If Target(1).Value2 = "Tacos" Then
      sndPlaySound "c:\FolderName\TacoSoundFileName.wav", 1
    Else
      sndPlaySound "c:\FolderName\OtherSoundFileName.wav", 1
    End If
  End If
End Sub

That's code on the worksheet object, not a standard module. If this is to run on 64-bit Excel, then you'd probably need directives around the lib call so it would use LongPtr.

If the cell (A1) is on the active worksheet:

wkb.Worksheets(Range("A1").Value2).Copy After:=BookKeep.Sheets(ThisWorkbook.Sheets.Count)

If you cannot guarantee that sheet will be active when the code is run, then, if the cell is on, for example, a sheet named MySheet:

wkb.Worksheets(wkb.Worksheets("MySheet").Range("A1").Value2).Copy After:=BookKeep.Sheets(ThisWorkbook.Sheets.Count)

I looked at your workbook and you do indeed have those cells identifiable by the same interior colour, so it's pretty easy:

Sub Clear_Cells()
Dim ws As Worksheet, cell As Range
  For Each ws In ActiveWorkbook.Worksheets
    For Each cell In ws.Cells.SpecialCells(xlCellTypeConstants)
      If cell.Interior.ColorIndex = 4 Then cell.Value2 = 0
    Next
  Next
End Sub

You'll need to write a program to do this. I would iterate through files in the folder (the Dir function is faster and simpler than instantiating a FileSystemObject), and select the data from each using ADO without opening the files. Create a new worksheet for each range and add the range as a new column to the Summary worksheet. If the files will get updated and need to be re-consumed, then you'll want to delete any Arif worksheets and clear any Arif columns from the Summary sheet at the start of the program.

If the Arif files can vary in the number or order of rows, then you'll have to ensure that the code can adapt to that. If you program in .Net rather than VBA, the ADO.Net provider lets you use Orientation=Horizontal so you would get each amount in a separate column, which would make that much easier, particularly if you create a class for the pay types.

I had a suggestion for using a global named range for the cells, but, after playing with it, I realized that naming different ranges on multiple sheets is a difficult topic. One could, however, create a worksheet scoped name (using the same name) on each sheet and then iterate through those in the macro to clear each. E.g., if you select the cells and create a worksheet-scoped name "Clear" on each worksheet, then code like this should work:

Sub ClearNamedRanges()
Dim ws As Worksheet
  For Each ws In ActiveWorkbook.Worksheets
    On Error Resume Next
    ws.names("Clear").RefersToRange.ClearContents
    On Error Goto 0
  Next
End Sub

Creating and maintaining the range names would be easy if you remember to scope them at the worksheet level (which means not using the Name Box to create), and the above macro is obviously simple and efficient.

In your Summary workbook, do you need a separate worksheet (tab) created for each entity or would you be satisfied with just the first worksheet (with a column for each entity)?

Are the 150 files in their own folder? If not, do they (and only they) all start with the name "Arif?" Are they all structured identically to your example (i.e., the same type of data in the same range)?