Solved

Pastevalues within excel VBA loop not working second time

Posted on 2012-03-17
8
351 Views
Last Modified: 2012-11-10
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

0
Comment
Question by:simonwait
  • 4
  • 4
8 Comments
 
LVL 42

Expert Comment

by:dlmille
ID: 37733575
On what line are you getting the 1004 error?

Dave
0
 
LVL 42

Expert Comment

by:dlmille
ID: 37733581
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

0
 
LVL 1

Author Comment

by:simonwait
ID: 37744720
I still get the same error with that code im afraid.
0
Salesforce Made Easy to Use

On-screen guidance at the moment of need enables you & your employees to focus on the core, you can now boost your adoption rates swiftly and simply with one easy tool.

 
LVL 1

Author Comment

by:simonwait
ID: 37744800
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!
0
 
LVL 42

Expert Comment

by:dlmille
ID: 37747312
can you post a sample workbook?

Dave
0
 
LVL 1

Accepted Solution

by:
simonwait earned 0 total points
ID: 37782027
I have actually wound up inadvertantly working around this issue by importing each csv into the current workbook.
0
 
LVL 42

Expert Comment

by:dlmille
ID: 37814391
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
0
 
LVL 1

Author Closing Comment

by:simonwait
ID: 38586566
I wound up resolving this in a not too efficient solution but it is one which works and therefore the question is redundant.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Technology opened people to different means of presenting information, but PowerPoint remains to be above competition. Know why PPT still works today.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

821 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question