Link to home
Start Free TrialLog in
Avatar of simonwait
simonwaitFlag for United Kingdom of Great Britain and Northern Ireland

asked on

Pastevalues within excel VBA loop not working second time

I have this code which gets stats from various log files and displays them.  Within it there is a loop which looks for each log in the folder and rips the data from it by copy and paste.  This seems to work fine the 1st time through the loop but the second time when it trys to paste the data into the "paste" sheet I get a 1004 error relating to the sizes of the copied cells and destination cells being different.  even if I pause the code and try it seems to fail.

I know copy/paste isnt very elegant or efficient but Im not sure of a better solution so im open to suggestions....

Cheers


Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Sub ErrorLog()

Dim FName As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With ActiveWorkbook.Worksheets("Show Specific Data").Sort
        .SetRange Range("D3:E1131")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

openfile = ActiveWorkbook.Name
Sheets.Add
ActiveSheet.Name = "Statistics"

'fileandpath = Application.GetOpenFilename(Title:="Please select a log file")
 GetFolder ("")
 Sep = Application.PathSeparator

         MyFile = Dir(CurDir() & Sep & "*.csv")

      ' Starts the loop, which will continue until there are no more files
      ' found.

Do While MyFile <> ""
Sheets.Add
ActiveSheet.Name = "Paste"
Workbooks.Open Filename:=MyFile
Db = ActiveWorkbook.Name
Cells.Select
Selection.Copy
Workbooks(openfile).Sheets("Paste").Activate

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Workbooks(Db).Close savechanges:=False
    Columns("A:A").Select
    Application.CutCopyMode = False
    Sheets.Add
    ActiveSheet.Name = "Data"

    Sheets("Paste").Activate
    lastcell = ActiveSheet.UsedRange.Rows.Count
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-4],RC[-1],RC[-3],RC[-1],RC[-2])"
    Range("E1").Select
    Selection.AutoFill Destination:=Range("E1:E" & lastcell), Type:=xlFillDefault
    Range("E1:E" & lastcell).Select
    Selection.Copy
'    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Data").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
        TrailingMinusNumbers:=True

Cells.Select

Cells.EntireColumn.AutoFit
Sheets("Statistics").Activate
slr = Sheets("Statistics").UsedRange.Rows.Count

Range("A" & slr).Value = ThisWorkbook.Name

Range("A" & slr + 2).Value = "Error"
Rows(slr).Font.Bold = True
Rows(slr + 2).Font.Bold = True

Range("B" & slr + 2).Value = "Error Code"
Range("C" & slr + 2).Value = "Instances"

Range("A" & slr + 3).Value = "Successful Moves"
Range("B" & slr + 3).Value = "Clear Move - 0"
Range("C" & slr + 3).Value = 0

Range("A" & slr + 4).Value = "No Error"
Range("B" & slr + 4).Value = 0
Range("C" & slr + 4).Value = 0

lastdatacell = Sheets("Data").UsedRange.Rows.Count

For x = 2 To lastdatacell
NewValue = False
If Sheets("Data").Range("E" & x).Value = "Nieuwe storing " Then

ErrorCode = Sheets("Data").Range("F" & x).Value

If ErrorCode = 0 Then
Range("C" & slr + 4).Value = Range("C" & slr + 4).Value + 1
GoTo skip
End If

On Error Resume Next
l = Application.WorksheetFunction.Match(ErrorCode, Range("B1:B1100"), 0)
On Error GoTo 0
If l > 1 Then
Sheets("Statistics").Range("C" & laststatrow).Value = Sheets("Statistics").Range("C" & laststatrow).Value + 1
Else
laststatrow = Sheets("Statistics").UsedRange.Rows.Count + 1
Sheets("Statistics").Range("B" & laststatrow).Value = ErrorCode
Sheets("Statistics").Range("A" & laststatrow).Value = "=VLOOKUP(RC[1],'Show Specific Data'!R[1]C[3]:R[5140]C[4],2)"
Sheets("Statistics").Range("C" & laststatrow).Value = 1
End If
l = 0
Else
GoTo skip:
End If
skip:

If Sheets("Data").Range("E" & x).Value = "Clear Move " And Sheets("Data").Range("F" & x) = 0 Then
Range("C" & slr + 3).Value = Range("C" & slr + 3).Value + 1
End If

Next x

Sheets("Statistics").Activate
Cells.Select
Cells.EntireColumn.AutoFit
Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sheets("Data").Delete
Sheets("Paste").Delete
      MyFile = Dir()
 
 Loop
thisfile = ActiveWorkbook.Name
thispath = ActiveWorkbook.Path

    Workbooks.Add
    Windows(thisfile).Activate
    Selection.Copy
    Windows("Book1").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
      


    ActiveWorkbook.SaveAs Filename:= _
        thispath & "\Error Statistics Output.xls", FileFormat:= _
        xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
        

Workbooks("Error Statistics Output").Close savechanges:=False
If Workbooks.Count > 1 Then
ActiveWorkbook.Close False
Else
Application.Quit
End If
        End Sub

Open in new window

Avatar of dlmille
dlmille
Flag of United States of America image

On what line are you getting the 1004 error?

Dave
Rather than a total rewrite, I did modify your select/copy/paste statements and hopefully this helps your code be a bit more seamless:


Option Explicit

Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function
Sub ErrorLog()

Dim FName As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    With ActiveWorkbook.Worksheets("Show Specific Data").Sort
        .SetRange Range("D3:E1131")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    openfile = ActiveWorkbook.Name
    Sheets.Add
    ActiveSheet.Name = "Statistics"

    'fileandpath = Application.GetOpenFilename(Title:="Please select a log file")
    GetFolder ("")
    Sep = Application.PathSeparator

    MyFile = Dir(CurDir() & Sep & "*.csv")

    ' Starts the loop, which will continue until there are no more files
    ' found.

    Do While MyFile <> ""
        Sheets.Add
        ActiveSheet.Name = "Paste"
        Workbooks.Open Filename:=MyFile
        Db = ActiveWorkbook.Name
        Cells.Copy
        Workbooks(openfile).Sheets("Paste").Activate

        Cells.PasteSpecial Paste:=xlPasteValues
        
        Workbooks(Db).Close savechanges:=False
        Columns("A:A").Select
        Application.CutCopyMode = False
        Sheets.Add
        ActiveSheet.Name = "Data"

        Sheets("Paste").Activate
        lastcell = ActiveSheet.UsedRange.Rows.Count
        Range("E1").Select
        ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-4],RC[-1],RC[-3],RC[-1],RC[-2])"
        Range("E1").Select
        Selection.AutoFill Destination:=Range("E1:E" & lastcell), Type:=xlFillDefault
        Range("E1:E" & lastcell).Copy
        '    Sheets.Add After:=Sheets(Sheets.Count)
        Sheets("Data").Cells.PasteSpecial Paste:=xlPasteValues
        
        Columns("A:A").Select
        Application.CutCopyMode = False
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                                Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
                                                                                           :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
                                                                                                   Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
                                                                                                   TrailingMinusNumbers:=True

        Cells.EntireColumn.AutoFit
        Sheets("Statistics").Activate
        slr = Sheets("Statistics").UsedRange.Rows.Count

        Range("A" & slr).Value = ThisWorkbook.Name

        Range("A" & slr + 2).Value = "Error"
        Rows(slr).Font.Bold = True
        Rows(slr + 2).Font.Bold = True

        Range("B" & slr + 2).Value = "Error Code"
        Range("C" & slr + 2).Value = "Instances"

        Range("A" & slr + 3).Value = "Successful Moves"
        Range("B" & slr + 3).Value = "Clear Move - 0"
        Range("C" & slr + 3).Value = 0

        Range("A" & slr + 4).Value = "No Error"
        Range("B" & slr + 4).Value = 0
        Range("C" & slr + 4).Value = 0

        lastdatacell = Sheets("Data").UsedRange.Rows.Count

        For x = 2 To lastdatacell
            NewValue = False
            If Sheets("Data").Range("E" & x).Value = "Nieuwe storing " Then

                ErrorCode = Sheets("Data").Range("F" & x).Value

                If ErrorCode = 0 Then
                    Range("C" & slr + 4).Value = Range("C" & slr + 4).Value + 1
                    GoTo skip
                End If

                On Error Resume Next
                l = Application.WorksheetFunction.Match(ErrorCode, Range("B1:B1100"), 0)
                On Error GoTo 0
                If l > 1 Then
                    Sheets("Statistics").Range("C" & laststatrow).Value = Sheets("Statistics").Range("C" & laststatrow).Value + 1
                Else
                    laststatrow = Sheets("Statistics").UsedRange.Rows.Count + 1
                    Sheets("Statistics").Range("B" & laststatrow).Value = ErrorCode
                    Sheets("Statistics").Range("A" & laststatrow).Value = "=VLOOKUP(RC[1],'Show Specific Data'!R[1]C[3]:R[5140]C[4],2)"
                    Sheets("Statistics").Range("C" & laststatrow).Value = 1
                End If
                l = 0
            Else
                GoTo skip:
            End If
skip:

            If Sheets("Data").Range("E" & x).Value = "Clear Move " And Sheets("Data").Range("F" & x) = 0 Then
                Range("C" & slr + 3).Value = Range("C" & slr + 3).Value + 1
            End If

        Next x

        Sheets("Statistics").Activate
        Cells.EntireColumn.AutoFit
        Cells.Copy
        Cells.PasteSpecial Paste:=xlPasteValues

        Sheets("Data").Delete
        Sheets("Paste").Delete
        MyFile = Dir()

    Loop
    thisfile = ActiveWorkbook.Name
    thispath = ActiveWorkbook.Path

    Workbooks.Add
    Windows(thisfile).Activate
    Selection.Copy
    Windows("Book1").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False




    ActiveWorkbook.SaveAs Filename:= _
                          thispath & "\Error Statistics Output.xls", FileFormat:= _
                          xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
                                                                                             , CreateBackup:=False


    Workbooks("Error Statistics Output").Close savechanges:=False
    If Workbooks.Count > 1 Then
        ActiveWorkbook.Close False
    Else
        Application.Quit
    End If
End Sub

Open in new window

Avatar of simonwait

ASKER

I still get the same error with that code im afraid.
if it helps I just tried copying the sheet using copy & move and it said it couldnt insert the sheet and that I should try copy/paste!
can you post a sample workbook?

Dave
ASKER CERTIFIED SOLUTION
Avatar of simonwait
simonwait
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Sorry - for some reason I didn't get your response until now.

Ok - its a long stretch of code and kind of hard to just "know" where your error might be occurring without your input on the line causing the 1004 error, and potential test data, etc.

If you can advise, I can help you debug, otherwise its a guessing game.

Dave
I wound up resolving this in a not too efficient solution but it is one which works and therefore the question is redundant.