simonwait
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
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
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
ASKER
I still get the same error with that code im afraid.
ASKER
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
Dave
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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
ASKER
I wound up resolving this in a not too efficient solution but it is one which works and therefore the question is redundant.
Dave