Results 1 to 9 of 9
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts

    Macro to clear data & open files

    I have written a macro to clear the data on sheets 1 to 3 and then to open two files in folder "extract"

    I would like to amend my code to allow me to select the files in the directory extract. Your assistance in this regard is most appreciated

    Code:
     Sub Open_Files()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets(1).Select
    With Range("A:Z").ClearContents
    Sheets(2).Select
    With Range("A:Z").ClearContents
    Sheets(3).Select
    With Range("A:B").ClearContents
    End With
     End With
    
    Workbooks.Open Filename:= _
            "C:\Extract\Stock List.csv"
        Workbooks.Open Filename:="C:\Extract\Creditors.csv"
       Windows("Stock List.csv").Activate
      
        With Range("A:Q")
        .Copy
            Windows("Stock paid for.xlsm").Activate
            Sheets(1).Select
            With Range("A1")
        .PasteSpecial Paste:=xlPasteValues
        Sheets(2).Select
        Windows("Creditors.csv").Activate
        Application.CutCopyMode = False
            With Range("A:L")
        .Copy
        Windows("Stock paid for.xlsm").Activate
        With Range("A1")
        .PasteSpecial Paste:=xlPasteValues
        Sheets(1).Select
        End With
          End With
            End With
             End With
               End With

    End Sub

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Here is a general procedure that you should be able to adapt. Add your code in the file processing. It uses the multi-select, so when the dialog is open, holding ctrl- will allow selecting and deselcting the files, holding shift will allow selecting the start and end files in a list (just like in WINDOWS).

    Code:
    Option Explicit
    Sub FileProcessingExample()
      'Variable Definition
      Dim vFilesToOpen As Variant
      Dim iFileCount As Integer
      Dim x As Integer
      Dim wkb As Workbook
      
      On Error GoTo ErrHandler
      Application.ScreenUpdating = False
      
      'Get files to work with
      'Change filter if desired
      vFilesToOpen = Application.GetOpenFilename _
        (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
        MultiSelect:=True)
      
      'Quit if NO files are selected
      If TypeName(vFilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
      End If
      
      'Act on each file
      iFileCount = UBound(vFilesToOpen)
      x = 1
      While x <= iFileCount
        Set wkb = Workbooks.Open(Filename:=vFilesToOpen(x))
      
        'Process each
        'Add your code here to process
        MsgBox wkb.FullName
        'Close workbook
        wkb.Close SaveChanges:=False
      
        'Get next file
        x = x + 1
      Wend
      
      'Give a message saying you are done
      If iFileCount = 1 Then
        MsgBox "1 File was processed"
      Else
        MsgBox iFileCount & " Files were processed"
      End If
      
    ExitHandler:
      Set wkb = Nothing
      Application.ScreenUpdating = True
      Exit Sub
      
    ErrHandler:
      MsgBox Err.Description
      Resume ExitHandler
    End Sub
    Steve

  3. #3
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts
    Hi Steve

    Thanks for the help. Will adapt the code to suit my needs

    Howard

  4. #4
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts
    Hi Steve

    I have adapted your code to suit my needs. The files to be opened are CSV files. The macro opens the folder for me to select the desired files, but the data is not copied on to the relevant sheets-see me code below. Kindly check and amend code

    Code:
     Sub Open_Files2()
    
    
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets(1).Select
    With Range("A:Z").ClearContents
    Sheets(2).Select
    With Range("A:Z").ClearContents
    Sheets(3).Select
    With Range("A:B").ClearContents
    End With
     End With
    Dim vFilesToOpen As Variant
      Dim iFileCount As Integer
      Dim x As Integer
      Dim wkb As Workbook
      
      On Error GoTo ErrHandler
    'Get files to work with
      'Change filter if desired
      vFilesToOpen = Application.GetOpenFilename _
        (FileFilter:="Microsoft CSV Files (*.csv), *.csv", _
            MultiSelect:=True)
      
      'Quit if NO files are selected
      If TypeName(vFilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
      End If
      
      'Act on each file
      iFileCount = UBound(vFilesToOpen)
      x = 1
      While x <= iFileCount
        Set wkb = Workbooks.Open(Filename:=vFilesToOpen(x))
      
        'Process each
        'Add your code here to process
        MsgBox wkb.FullName
        'Close workbook
        'wkb.Close SaveChanges:=False
      
        'Get next file
        x = x + 1
      Wend
      
      'Give a message saying you are done
      If iFileCount = 1 Then
        MsgBox "1 File was processed"
      Else
        MsgBox iFileCount & " Files were processed"
      End If
      
    ExitHandler:
      Set wkb = Nothing
      Application.ScreenUpdating = True
      Exit Sub
      
    ErrHandler:
      MsgBox Err.Description
      Resume ExitHandler
       
       Windows("Stock List.csv").Activate
      
        With Range("A:Q")
        .Copy
            Windows("Stock paid for.xlsm").Activate
            Sheets(1).Select
            With Range("A1")
        .PasteSpecial Paste:=xlPasteValues
        Sheets(2).Select
       Windows("Creditors.csv").Activate    
    Application.CutCopyMode = False
            With Range("A:L")
        .Copy
          Windows("Stock paid for.xlsm").Activate
        With Range("A1")
        .PasteSpecial Paste:=xlPasteValues
        Sheets(1).Select
        End With
          End With
            End With
             End With
               End With
    End Sub

  5. #5
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    YOu need to put your code items to process each workbook within the loop of open and close each workbook:

    Code:
        Set wkb = Workbooks.Open(Filename:=vFilesToOpen(x))
        'Process each
        'Add your code here to process
        MsgBox wkb.FullName
        'Close workbook
        'wkb.Close SaveChanges:=False
    The Msgbox was only an example of what it would do with each workbook while it was opened.

    Before you try modifying the example code, you should know what each step you want your final code to do and also ensure that you know what each line in the example code does. I put comments in the code to aid in this.

    [Stepping through the code can aid in this, though comment out the screenupdating = false line to watch the code run...]

    Steve

  6. #6
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts
    Hi Steve

    Thanks for the advise. Will comment out screenupdating = false line before stepping through the code


    Howard

  7. #7
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts
    Hi Steve

    By playing around with the code, I eventually got it to work. Thanks for all your assistance, advise & input

    Howard


    Code:
    Sub Open_Files()
    
    
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Sheets(1)
        .Range("A:Z").ClearContents
    End With
    With Sheets(2)
        .Range("A:Z").ClearContents
    End With
    With Sheets(3)
        .Range("A:B").ClearContents
    End With
    
    
    Dim vFilesToOpen As Variant
      Dim iFileCount As Integer
      Dim x As Integer
      Dim wkb As Workbook
     
    'Get files to work with
      'Change filter if desired
      vFilesToOpen = Application.GetOpenFilename _
        (FileFilter:="Microsoft CSV Files (*.csv), *.csv", _
            MultiSelect:=True)
      
      
       
       Windows("Stock List.csv").Activate
        With Range("A:Q")
        .Copy
      Windows("Stock paid for.xlsm").Activate
        Sheets(1).Select
        Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValues
         Windows("Creditors.csv").Activate    
        With Range("A:L")
            .Copy
       Windows("Stock paid for.xlsm").Activate
        Sheets(2).Select
        Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        
                  End With
                   End With
               
               End Sub

  8. #8
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Some comments:
    1) I am confused, the code you asked us to create (to ask for the files in a folder), is in your code, but is not used by your code, so the following lines, seem to me to serve no purpose in the posted code:

    Dim vFilesToOpen As Variant
    Dim iFileCount As Integer
    Dim x As Integer
    Dim wkb As Workbook

    'Get files to work with
    'Change filter if desired
    vFilesToOpen = Application.GetOpenFilename _
    (FileFilter:="Microsoft CSV Files (*.csv), *.csv", _
    MultiSelect:=True)

    Some code cleanup:
    2) If you only have 1 (or even 2) line inside a With/End With, there is very little need for the construction:
    For example the code:
    Sheets(1).Range("A:Z").ClearContents

    is shorter than:
    With Sheets(1)
    .Range("A:Z").ClearContents
    End With

    With is used to not have to repeat the explicit reference, since you are entering it only once, the With/End With are the extra typing...

    3) Activate, and Select are not required in code and just slow it down:
    Windows("Stock List.csv").Activate
    With Range("A:Q")
    .Copy

    Can be shortened to:
    Windows("Stock List.csv").Range("A:Q").Copy

    And
    Windows("Stock paid for.xlsm").Activate
    Sheets(1).Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues

    Can be shortened to:
    Windows("Stock paid for.xlsm").Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues

    The other section can also be modified the same way.

    Steve

  9. #9
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts
    Hi Steve

    Thanks for the reply and your comments, which I have noted. Your input is always appreciated

    Howard

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •