Posts by daniel.c

daniel.c · Oct 8th 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

Hope this will be OK. I forgot some things :

Code

Private Sub Workbook_Open()
    Dim Plage As Range, c As Range, Fich As String
    Const myPath = "e:\donnees\daniel\mpfe\test\"
    With Sheets("Not Updated Master Workbook")
        ' opens first workbook in the folder defined by "Const"
        Fich = Dir(myPath & "*.xls")
        'Loop into the folder
        Do While Fich <> ""
            ' case workbook is "SlaveBook.xls"
            If Fich = "SlaveBook.xls" Then
                'set autofilter
                .Range("E1:AA1").AutoFilter
                ' Set filter on column AA
                Range(.[E1], .[A65536].End(xlUp)).AutoFilter Field:=23, Criteria1:="="
                ' set filter on column O
                Range(.[E1], .[A65536].End(xlUp)).AutoFilter Field:=10, Criteria1:="M"
                ' define "Plage" as database offset 1
                Set Plage = .Range("_filterdatabase").Offset(1)
                ' case at least one row is filtered out
                If Plage.Resize(, 1).SpecialCells(xlCellTypeVisible).Count > 1 Then
                    ' assign filtered rows, first column only to Plage
                    Set Plage = Plage.Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
                    ' open workbook
                    Workbooks.Open myPath & "SlaveBook.xls"
                    'Loops into Plage
                    For Each c In Plage
                        c.Offset(, 22) = Application.VLookup(c, [E:AA], 23, 0)
                        c.Offset(, 22).NumberFormat = "dd/mm/yy"
                    Next c
                    'Close File
                    Workbooks(Fich).Close False
                End If
                'reset autofilter
                .Range("E1:AA1").AutoFilter
            ElseIf Fich = "SlaveBook2.xls" Then
                ' same thing for the other workbook
                .Range("E1:AA1").AutoFilter
                Range(.[E1], .[A65536].End(xlUp)).AutoFilter Field:=23, Criteria1:="="
                Range(.[E1], .[A65536].End(xlUp)).AutoFilter Field:=10, Criteria1:="I"
                Set Plage = .Range("_filterdatabase").Offset(1)
                If Plage.Resize(, 1).SpecialCells(xlCellTypeVisible).Count > 1 Then
                    Set Plage = Plage.Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
                    Workbooks.Open myPath & "SlaveBook2.xls"
                    For Each c In Plage
                        c.Offset(, 22) = Application.VLookup(c, [A:J], 10, 0)
                        c.Offset(, 22).NumberFormat = "dd/mm/yy"
                    Next c
                    Workbooks(Fich).Close False
                End If
                .Range("E1:AA1").AutoFilter
            End If
            Fich = Dir
        Loop
    End With
End Sub

Display More

If you have any trouble with it, please, post the workbooks again to refresh my mind.
Daniel

daniel.c · Sep 17th 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

Hi.
In the two macros, add the following lines at the beginning of the macro :

Code

Application.ScreenUpdating = False
    Calc = Application.Calculation
    Application.Calculation = xlCalculationManual

and, at the end, add :

Code

Application.Calculation = Calc
    Application.ScreenUpdating = True

At the top of the module, add :

Code

Public Calc As Long

daniel.c · Sep 15th 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

Sorry have to written such a nonsense. It really does not matter to have data in columns A:D. Next time I'll Have a coffee before answering

daniel.c · Sep 12th 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

It is important to be sure that there are no data in columns A:D in the master workbook. As the 2 slave workbooks don't have the same structure, I can't use a loop and there must be two different treatments.

Code

Private Sub Workbook_Open()
    Dim Plage As Range, c As Range, Fich As String
    Const myPath = "e:\donnees\daniel\mpfe\test\"
    With Sheets("Not Updated Master Workbook")
        Fich = Dir(myPath & "*.xls")
        Do While Fich <> ""
            If Fich = "SlaveBook.xls" Then
                .Range("E1:AA1").AutoFilter
                Range(.[E1], .[A65536].End(xlUp)).AutoFilter Field:=23, Criteria1:="="
                Range(.[E1], .[A65536].End(xlUp)).AutoFilter Field:=10, Criteria1:="M"
                Set Plage = .Range("_filterdatabase").Offset(1)
                If Plage.Resize(, 1).SpecialCells(xlCellTypeVisible).Count > 1 Then
                    Set Plage = Plage.Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
                    Workbooks.Open myPath & "SlaveBook.xls"
                    For Each c In Plage
                        c.Offset(, 22) = Application.VLookup(c, [E:AA], 23, 0)
                        c.Offset(, 22).NumberFormat = "dd/mm/yy"
                    Next c
                    Workbooks(Fich).Close False
                End If
                .Range("E1:AA1").AutoFilter
            ElseIf Fich = "SlaveBook2.xls" Then
                .Range("E1:AA1").AutoFilter
                Range(.[E1], .[A65536].End(xlUp)).AutoFilter Field:=23, Criteria1:="="
                Range(.[E1], .[A65536].End(xlUp)).AutoFilter Field:=10, Criteria1:="I"
                Set Plage = .Range("_filterdatabase").Offset(1)
                If Plage.Resize(, 1).SpecialCells(xlCellTypeVisible).Count > 1 Then
                    Set Plage = Plage.Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
                    Workbooks.Open myPath & "SlaveBook2.xls"
                    For Each c In Plage
                        c.Offset(, 22) = Application.VLookup(c, [A:J], 10, 0)
                        c.Offset(, 22).NumberFormat = "dd/mm/yy"
                    Next c
                    Workbooks(Fich).Close False
                End If
                .Range("E1:AA1").AutoFilter
            End If
            Fich = Dir
        Loop
    End With
End Sub

Display More

daniel.c · Sep 12th 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

The important thing for me to know is what is the first column of data.

daniel.c · Sep 11th 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

1. 39126 means "13/02/07"; It's the way Excel computes time (day 1 is "01/01/1900" (sometimes "01/01/1904). Enter that date in a celland apply standard number format and you'll get 39126. I added a line of code to correct it :

Code

c.Offset(, 26).NumberFormat = "dd/mm/yy"

The macro I post below should certainly be modified. I used column C to add the department. Moreover, if column A is not used, the filters instructions have to be modified. I created three department files :
- dept1.xls
- dept2.xls
- dept3.xls
I am just thinking that I did not change their structures (IDs in column A and dates in B).
You better send a new sample file. Anyway, here is my code (see also attached file).

Code

Private Sub Workbook_Open()
    Dim Plage As Range, c As Range, Fich As String, Crit As String
    Const myPath = "e:\donnees\daniel\mpfe\"
    With Sheets("Not Updated Master Workbook")
        Fich = Dir(myPath & "*.xls")
        Do While Fich <> ""
            Crit = ""
            Select Case Fich
                Case "dept1.xls"
                    Crit = "dept1"
                    Workbooks.Open myPath & Fich
                Case "dept2.xls"
                    Crit = "dept2"
                    Workbooks.Open myPath & Fich
                Case "dept3.xls"
                    Crit = "dept3"
                    Workbooks.Open myPath & Fich
            End Select
            If Crit <> "" Then
                .Range("A1:AA1").AutoFilter
                Range(.[A1], .[A65536].End(xlUp)).AutoFilter Field:=27, Criteria1:="="
                Range(.[A1], .[A65536].End(xlUp)).AutoFilter Field:=3, Criteria1:=Crit
                Set Plage = .Range("_filterdatabase").Offset(1)
                On Error GoTo Suite
                Set Plage = Plage.Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
                For Each c In Plage
                    c.Offset(, 26) = Application.VLookup(c.Offset(, 4), [A:B], 2, 0)
                    c.Offset(, 26).NumberFormat = "dd/mm/yy"
                Next c
Suite:
                On Error GoTo 0
                .Range("A1").AutoFilter
                Workbooks(Fich).Close False
            End If
            Fich = Dir
        Loop
    End With
End Sub

Display More

Of course, I'll add comments when the macro will be finalized.

daniel.c · Sep 10th 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

Try :

Code

Private Sub Workbook_Open()
    Dim Plage As Range, c As Range
    Const myPath = "e:\donnees\daniel\mpfe\"
    With Sheets("Not Updated Master Workbook")
        Workbooks.Open myPath & "SlaveBook.xls"
        .Range("A1").AutoFilter
        Range(.[A1], .[A65536].End(xlUp)).AutoFilter Field:=2, Criteria1:="="
        Set Plage = .Range("_filterdatabase").Offset(1)
        Set Plage = Plage.Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
        For Each c In Plage
            c.Offset(, 1) = Application.VLookup(c, [A:B], 2, 0)
        Next c
        .Range("A1").AutoFilter
    End With
    Workbooks("SlaveBook.xls").Close False
End Sub

Display More

A missing dot that matters !

daniel.c · Sep 10th 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

I moved the "updated slave workbook" sheet to a new workbook which i named "SlaveBook.xls". Paste the following code in the "ThisWorkbook" module :

Code

Private Sub Workbook_Open()
    Dim Plage As Range, c As Range
    Const myPath = "e:\donnees\daniel\mpfe\"
    With Sheets("Not Updated Master Workbook")
        Workbooks.Open myPath & "SlaveBook.xls"
        .Range("A1").AutoFilter
        .Range(.[A1], .[A65536].End(xlUp)).AutoFilter Field:=2, Criteria1:="="
        Set Plage = .Range("_filterdatabase").Offset(1)
        Set Plage = Plage.Resize(Plage.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
        For Each c In Plage
            c.Offset(, 1) = Application.VLookup(c, [A:B], 2, 0)
        Next c
        Range("A1").AutoFilter
    End With
    Workbooks("SlaveBook.xls").Close False
End Sub

Display More

As you have 3 slave files, you'll have to filter the department column too.

daniel.c · Sep 10th 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

Quote

Does this mean that I have to traverse the entire worksheet (several thousand entries), every time I open the master workbook, and crosscheck every blank payment date with the actual entry in the slave workbook to see if the payment date has been added since the last time? Or is there an easier way?

Yes, but you did not have to read each row. You should filter the data to find the empty payment dates and work on the filtered rows. Alternatively, you may use the "Find" instruction to find blank payment date cells. Feel free to post a sample file, and i'll return the corresponding code.

daniel.c · Sep 9th 2008

Re: Export Email Text Into Worksheet

The macro is intended to be an Excel macro. Could you please attach your file ?

daniel.c · Sep 3rd 2008

Re: Create Mailing Lists From A Spreadsheet

The command button and the drop down are on the "Interface" sheet so, you can hide the "data" sheet. In the attached file, the sheet is "veryhidden", that means that it can only be displayed by macro.
For further protection, the workbook must be protected with a password, so that it has to be unprotected again before the sheet can be displayed.

daniel.c · Sep 3rd 2008

Re: Prevent Editting And Selecting Of Range In Newly Created Workbook

You should not be able to edit the cells if they are locked and the sheet protected. Is this the case or do I miss something ? To prevent the selection of locked cells, add :

Code

ActiveSheet.EnableSelection = xlUnlockedCells

after :

Code

ActiveSheet.Protect , Password:="whatyouwant"

daniel.c · Sep 3rd 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

If the department ID is stored in the sales row, you don't need to store anything, it will be simple to retrieve it :
1. retrieve the last row in the master file;
2. retrieve the corresponding sale in the source file.
If it's not the case, yes, store it in a cell of the master file.

daniel.c · Sep 3rd 2008

Re: Prevent Editting And Selecting Of Range In Newly Created Workbook

Try :

Code

For lLoop = 2 To 251 'first row of data to last row.
    If ws1.Cells(lLoop, 4).Value = "x" Then '4 = Column D
        ws1.Activate
        ws1.Range("e" & lLoop & ":g" & lLoop).Copy
        ws1.Range("B1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Rng1.Copy
        Workbooks.Add
        ActiveSheet.Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ActiveSheet.Range("A1").Select
        ActiveSheet.SaveAs varPath & "\Student Data Files\" & ActiveSheet.Range("B1") & ".xls"
        [B]Cells.Locked = False
        Range("B1:B504").Locked = True
        ActiveSheet.Protect , Password:="whatyouwant"[/B]        
        ActiveWorkbook.Close True
         
    Else
    End If
     
Next lLoop

Display More

daniel.c · Sep 3rd 2008

Re: Create Mailing Lists From A Spreadsheet

Try from sheet Interface :

Code

Dim c As Range, Col As Integer, Str As String
    If [C4] = "" Then Exit Sub
    With Sheets("Data")
        Col = Application.Match([C4], .Rows(2), 0)
        For Each c In Range(.Cells(3, Col), .Cells(65000, Col).End(xlUp))
            If c = "Yes" And .Cells(c.Row, 3) = "Yes" Then
                Str = Str & .Cells(c.Row, 2) & ";"
            End If
        Next c
        Str = Left(Str, Len(Str) - 1)
    End With
    With New DataObject
        .SetText Str
        .PutInClipboard
    End With
    MsgBox Str

Display More

daniel.c · Sep 2nd 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

First, sorry for the folder change ;-))
As your code works, you copy cell A1 of sheet 1 from the first file, cell A1 of sheet 2 from the second file, etc.
I think you should replace :

Code

Source.Sheets(i).Range("A1").Copy Tgt

with

Code

Source.Sheets(1).Range("A1").Copy Tgt

I tested the modified macro and it seems to work (provided you only want cell A1 to be copied).
As regards to :

Code

myFileName = Dir(.FoundFiles(i))

it only returns the file name, which I use in the Select Case - End Select part.

daniel.c · Sep 2nd 2008

Re: Automatic Updating Of Master Worbook From Slave Workbooks

Not sure it's quite what you want... Try :

Code

Sub Merge()
    Dim i As Integer
    Dim Source As Workbook
    Dim Destination As Workbook
    Dim myFileName As String
     
     
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
     
    On Error Resume Next
     
    Set Destination = ThisWorkbook
     
     
    With Application.FileSearch
        .NewSearch
         'Change path to suit
        '.LookIn = "C:\Documents and Settings\nochhau\Desktop\Excelprosjekt"
        .LookIn = "e:\donnees\daniel"
        .FileType = msoFileTypeExcelWorkbooks
         
         
        If .Execute > 0 Then 'Workbooks in folder
            For i = 1 To .FoundFiles.Count ' Loop through all
                 'Set Paste target first
                myFileName = Dir(.FoundFiles(i))
                
                'Open Souce file
                Set Source = Workbooks.Open(.FoundFiles(i))
                With Destination.Sheets(1)
                     '''''' Here I would then have to make an if to do a different selection based on what input file I have
                    Select Case myFileName
                    Case "dept1.xls"
                        'Here selection for first file
                    Case "dept2.xls"
                        'Here selection for second file
                    Case "dept3.xls"
                        'Here selection for third file
                    End Select
                    Set Tgt = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
                End With
                 'Copy and paste to destination
                Source.Sheets(i).Range("A1").Copy Tgt
                 'Close source file without  saving
                Source.Close False
            Next i
             
        End If
         
    End With
     
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.CutCopyMode = False
End Sub

Display More

daniel.c · Sep 1st 2008

Re: Change Message Box To Select Folder Not File

Just put it :

Code

Sub Test()
    Dim Msg As String, myFolder As String
    'retrieve folder name in myFolder variable
    myFolder = GetDirectory(Msg)
    '*** subsequent code
End Sub

daniel.c · Sep 1st 2008

Re: Change Message Box To Select Folder Not File

Did you paste it in a standard module (not a form or sheet module ) ?
Have a look at the attached file.

daniel.c · Sep 1st 2008

Re: Change Message Box To Select Folder Not File

If that's the case, paste the following code at the beginning of a module and execute the "test" macro. The result will be displayed in a msgbox :

Code

Option Explicit
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type


'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _
  As Long


Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long




Sub Test()
    Dim Msg As String
    Msg = "Choose a folder"
    MsgBox GetDirectory(Msg)
End Sub


Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer
 
'   Root folder = Desktop
    bInfo.pidlRoot = 0&


'   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
    
'   Type of directory to return
    bInfo.ulFlags = &H1


'   Display the dialog
    x = SHBrowseForFolder(bInfo)
    
'   Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function

Display More

Posts by daniel.c

Automatic Updating Of Master Worbook From Slave Workbooks

Automatic Updating Of Master Worbook From Slave Workbooks

Automatic Updating Of Master Worbook From Slave Workbooks

Automatic Updating Of Master Worbook From Slave Workbooks

Automatic Updating Of Master Worbook From Slave Workbooks

Automatic Updating Of Master Worbook From Slave Workbooks

Automatic Updating Of Master Worbook From Slave Workbooks

Automatic Updating Of Master Worbook From Slave Workbooks

Automatic Updating Of Master Worbook From Slave Workbooks

Export Email Text Into Worksheet

Join Email Addresses Meeting Condition In Corresponding Cells

Code To Prevent Editing & Selecting Of Range Worksheet

Automatic Updating Of Master Worbook From Slave Workbooks

Code To Prevent Editing & Selecting Of Range Worksheet

Join Email Addresses Meeting Condition In Corresponding Cells

Automatic Updating Of Master Worbook From Slave Workbooks

Automatic Updating Of Master Worbook From Slave Workbooks

Dialog Box To Select Folder Only

Dialog Box To Select Folder Only

Dialog Box To Select Folder Only