VB makes clipboard warning

[TorrO]

Hi

I try to copy a column from each file in a folder and past it in a new workbook.

Any tip?

Files in folder:

I get this waring, i need to automatic answer No:

Sub LesKatalog()


Dim folderPath As String
folderPath = "d:\Gdrive\NAS\PulseFit\PulseFitReadFilesVB\" ' Change this to the path of your folder

Dim fileName As String
fileName = Dir(folderPath & "\*.xls")



Dim wbDestination As Workbook
Set wbDestination = Workbooks.Add

Dim wsDestination As Worksheet
Set wsDestination = wbDestination.Sheets.Add

Dim wbSource As Workbook
Dim fileNames() As String
Dim i As Integer
i = 0

Do While fileName <> ""
    ReDim Preserve fileNames(i)
    fileNames(i) = fileName
    i = i + 1
    fileName = Dir(folderPath & "\*.xlsx")
Loop

If i = 0 Then
    MsgBox "No Excel workbooks found in the specified folder."
    Exit Sub
End If

' Sort fileNames()
Dim j As Integer
For i = LBound(fileNames) To UBound(fileNames) - 1
    For j = i + 1 To UBound(fileNames)
        On Error Resume Next
        If CDate(Left(fileNames(i), 10)) > CDate(Left(fileNames(j), 10)) Then
            Dim temp As String
            temp = fileNames(i)
            fileNames(i) = fileNames(j)
            fileNames(j) = temp
        End If
        On Error GoTo 0
    Next j
Next i

For i = LBound(fileNames) To UBound(fileNames)
    Set wbSource = Workbooks.Open(folderPath & "\" & fileNames(i))
    wbSource.Sheets(1).Range("A1", wbSource.Sheets(1).Range("A1").End(xlDown)).Copy
    wsDestination.Range("A" & wsDestination.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    wbSource.Close False
     Application.CutCopyMode = False
Next i

End Sub

 

[smozgur]

You can suppress the message by simply disabling alerts just before closing the workbook and enabling it back afterward. In the original code:

    Application.DisplayAlerts = False
    wbSource.Close False
    Application.DisplayAlerts = True

An alternative way and my recommendation would be not to use the Copy method, but directly transfer the cell values to the target range. The current loop can be modified as below:

For i = LBound(fileNames) To UBound(fileNames)
    Set wbSource = Workbooks.Open(folderPath & "\" & fileNames(i))
    ' Using a variable for the range, because I will reuse the range for columns and rows count
    Dim rng As Range
    Set rng = wbSource.Sheets(1).Range("A1", wbSource.Sheets(1).Range("A1").End(xlDown))
    wsDestination.Range("A" & wsDestination.Rows.Count).End(xlUp).Offset(1, 0).Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    wbSource.Close False
Next i

 

[smozgur]

You can suppress the message by simply disabling alerts just before closing the workbook and enabling it back afterward. In the original code:

Application.DisplayAlerts = False
wbSource.Close False
Application.DisplayAlerts = True

Note: You can also disable the alert just before the loop, but you might miss other important alerts, so that's why I limited its scope right before and after the workbook close action.

 

[TorrO]

Thanks, it worked for the alert.

I tested this, but it only executed once, I have 2 files in directory

For i = LBound(fileNames) To UBound(fileNames)
    Set wbSource = Workbooks.Open(folderPath & "\" & fileNames(i))
    ' Using a variable for the range, because I will reuse the range for columns and rows count
    Dim rng As Range
    Set rng = wbSource.Sheets(1).Range("F1", wbSource.Sheets(1).Range("F1").End(xlDown))
    wsDestination.Range("A" & wsDestination.Rows.Count).End(xlUp).Offset(1, 0).Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    wbSource.Close False
Next i

 

[smozgur]

It is not related to the initial question or the solution I suggested but to another part of your code.
You have .xls files in the folder, the initial filename assignment uses ".xls" however, the one in the loop uses ".xlsx". Change it to ".xls" as well and retry.

fileName = Dir(folderPath & "\*.xlsx")

 

[smozgur]

It is not related to the initial question or the solution I suggested but to another part of your code.
You have .xls files in the folder, the initial filename assignment uses ".xls" however, the one in the loop uses ".xlsx". Change it to ".xls" as well and retry.

fileName = Dir(folderPath & "\*.xlsx")

It means, your code already cannot process the second .xls file because of the reason I explained. Neither in the original code nor after the changes I suggested for suppressing the alert.

 

[TorrO]

Hi

Thanks again!

Changed to xls, sorry not better:

here is the code I run:

Sub LesKatalog()


Dim folderPath As String
folderPath = "d:\Gdrive\Torstein til NAS\PulseFit\PulseFitReadFilesVB\" ' Change this to the path of your folder

Dim fileName As String
fileName = Dir(folderPath & "\*.xls"


Dim wbDestination As Workbook
Set wbDestination = Workbooks.Add

Dim wsDestination As Worksheet
Set wsDestination = wbDestination.Sheets.Add

Dim wbSource As Workbook
Dim fileNames() As String
Dim i As Integer
i = 0

Do While fileName <> ""
    ReDim Preserve fileNames(i)
    fileNames(i) = fileName
    i = i + 1
    fileName = Dir(folderPath & "\*.xls")
Loop

If i = 0 Then
    MsgBox "No Excel workbooks found in the specified folder."
    Exit Sub
End If

' Sort fileNames()
Dim j As Integer
For i = LBound(fileNames) To UBound(fileNames) - 1
    For j = i + 1 To UBound(fileNames)
        On Error Resume Next
        If CDate(Left(fileNames(i), 10)) > CDate(Left(fileNames(j), 10)) Then
            Dim temp As String
            temp = fileNames(i)
            fileNames(i) = fileNames(j)
            fileNames(j) = temp
        End If
        On Error GoTo 0
    Next j
Next i

For i = LBound(fileNames) To UBound(fileNames)
    Set wbSource = Workbooks.Open(folderPath & "\" & fileNames(i))
    ' Using a variable for the range, because I will reuse the range for columns and rows count
    Dim rng As Range
    Set rng = wbSource.Sheets(1).Range("F1", wbSource.Sheets(1).Range("F1").End(xlDown))
    wsDestination.Range("A" & wsDestination.Rows.Count).End(xlUp).Offset(1, 0).Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    wbSource.Close False
Next i

End Sub

 

[TorrO]

Hi, I did mix up the code, sorry, an old version was opened. I will try again tomorrow, my head is not on top now.
Thanks for helping me!

 

[smozgur]

Since I assumed it works without problems, I didn't pay attention to any mistakes in the existing code. The first Dir() with the path parameter will get the first file, then you should use the Dir() statement without parameters to loop through files with the same pattern in the same directory.

Could you please change your original code and not use any parameter for the Dir() statement in the loop as shown below:

Do While fileName <> ""
    ReDim Preserve fileNames(i)
    fileNames(i) = fileName
    i = i + 1
    fileName = Dir()
Loop

 

[smozgur]

Hi, I did mix up the code, sorry, an old version was opened. I will try again tomorrow, my head is not on top now.
Thanks for helping me!

No, the problem I explained above is the actual problem (unless there are other problems in the code). With the path parameter in the loop, the Dir() function will keep finding the same file and it will fail as it fails with an Overflow error since it will try to increment the "i" variable more than the integer variable type limit. You need to fix it anyway.