Solved

Pastevalues within excel VBA loop not working second time

Posted on 2012-03-17
8
345 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
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 
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

Backup Your Microsoft Windows Server®

Backup all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

Question has a verified solution.

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

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

920 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

14 Experts available now in Live!

Get 1:1 Help Now