Solved

Pastevalues within excel VBA loop not working second time

Posted on 2012-03-17
8
339 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 41

Expert Comment

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

Dave
0
 
LVL 41

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
 
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
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 41

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 41

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

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

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,…
Article by: Leon
Software Metering within our group of companies has always been an afterthought until auditing of software and licensing became a pain point. Orchestrator and SCCM metering gave us the answer and it was an exciting process.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
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…

744 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now