Excel VBA, Paste special adds trailing zeroes - vba

Question

I have raw data from ANSYS mechanical exported as .xml with the following format (2 rows, x number of columns):
Steps Time [s] [A] C1 (Total) [N]
1 1 1, 4,4163e+005
I have a lot of files and I'm trying to combine these into one table in Excel using VBA. The script works fine with one exception, it does not interpret the scientific format correctly. My result is as follows:
Steps 1
Time [s] 1
[A] C1 (Total) [N] 4,42E+09
Code looks as follows:
Private Sub CommandButton1_Click()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim wb1 As Excel.Workbook
Dim wb2 As Excel.Workbook
Set wb1 = ThisWorkbook
wb1.Sheets("Sheet1").Cells.ClearContents
'define table headers on row 1
wb1.Sheets("Sheet1").Range("A1:A1").Value = "Load Case"
wb1.Sheets("Sheet1").Range("B1:B1").Value = "Load Case"
wb1.Sheets("Sheet1").Range("C1:C1").Value = "Load Case"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'directory of source files
directory = "C:\Users\xxxxxxx\Ansysxls\"
fileName = Dir(directory & "*.xl??")
'Define the last used row in the target sheet
LastRow = wb1.Sheets("Sheet1").Cells(wb1.Sheets("Sheet1").Rows.Count, "B").End(xlUp).Row + 1
Do While fileName = "Asymmetric.xls"
'define which workbook to open
Set wb2 = Workbooks.Open(directory & fileName)
'loop through sheets in source file
For Each sheet In Workbooks(fileName).Worksheets
'Select range in source file
wb2.Sheets(sheet.Name).Range("A1").CurrentRegion.Select
'Replace commas with dot
Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Copy
'Paste Special to target file <-----Smth wrong in my paste special???
wb1.Sheets("Sheet1").Range("B" & LastRow).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats, SkipBlanks:=True, Transpose:=True
wb2.Sheets(sheet.Name).Activate
Next sheet
'define first row and last row of last import and add from what file the came
FirstRow = LastRow
LastRow = wb1.Sheets("Sheet1").Cells(wb1.Sheets("Sheet1").Rows.Count, "B").End(xlUp).Row + 1
'remove file ending ".xls" from column
wb1.Sheets("Sheet1").Range("A" & FirstRow & ":" & "A" & LastRow).Value = Left(fileName, Len(fileName) - 4)
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Create Table
wb1.Sheets("Sheet1").ListObjects.Add(xlSrcRange, Sheets("Sheet1").Range("A1").CurrentRegion, , xlYes, Header = xlYes).Name = "myTable1"
End Sub
Can anybody help me understand why it changes with from e+5 to e+9?

Answer 1

Excel will 'interpret' the Total [N]) value (which has the comma in it) depending on the numbering system of your Excel application.
I believe if you paste a value of 4,4163e+005 into your worksheet, you will see a value of 4416300000, assuming your thousands are comma separated. In your case, however, you seem to want to convert the comma to a decimal point so that the true value is 441630. This can only be done if the value is a string, but yours probably isn't, it's most likely a number. I'm afraid I rather suspect your search and replace line makes no changes at all.
Although I can't see the values themselves, my bet would be that you need to divide each value by 10000 and then set the number format of your cells to "0.0000E+00".
I've put some code below that will loop through the values and make that change for you. You'll see that I've assumed each sheet only contains the 2 x 4 cell size, so adjust this if you need to.
Other comments about your code:
I think you need to put your last row update within the sheet loop. At a quick glance it looks as though you might be overwriting previous sheet data (ie the only data being written to your target is the source's last sheet data).
I'm not sure what you're intentions are with the Dir() function and then checking for a unique filename. It looks to me as if that will only loop once on a file called "Asymmetric.xls". If this is what you want then just define that workbook as an object. If you want to read all the workbooks in the directory then you need to run the Dir() loop until filename = "". That's what I've assumed in my code.
Private Sub CommandButton1_Click()
Dim directory As String
Dim fileName As String
Dim source As Workbook
Dim sht As Worksheet
Dim targetRng As Range
Dim rawValues As Variant
Dim revisedValues() As Variant
Dim rDimension As Long
Dim cDimension As Integer
Dim r As Long
Dim c As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'define table headers on row 1
With ThisWorkbook.Sheets("Sheet1")
.Cells.ClearContents
.Cells(1, 1).Resize(, 3).Value = _
Array("Filename", "Item", "Value")
Set targetRng = .Cells(2, 2) 'ie "B2"
End With
'Directory of source files
directory = "C:\Users\xxxxxxx\Ansysxls\"
fileName = Dir(directory & "*.xl??")
Do Until fileName = ""
'define which workbook to open
Set source = Workbooks.Open(directory & fileName)
'loop through sheets in source file
For Each sht In source.Worksheets
'Select range in source file
If Not IsEmpty(sht.Range("A1")) Then
rawValues = sht.Range("A1").CurrentRegion.Value2
' Manipulate the acquired data
rDimension = UBound(rawValues, 1)
cDimension = UBound(rawValues, 2)
' Transpose the dimensions and manipulate the totalN value
ReDim revisedValues(1 To cDimension, 1 To rDimension)
For r = 1 To rDimension
For c = 1 To cDimension
If r = 2 And c = 4 Then ' it's totalN
' Convert the data to a LongLong and divide by 10000
revisedValues(c, r) = CLngLng(rawValues(r, c)) / 10000
Else
revisedValues(c, r) = rawValues(r, c)
End If
Next
Next
'Populate the target sheet with revised values
Set targetRng = targetRng.Resize(cDimension, rDimension)
targetRng.Value2 = revisedValues
' Define the scientific format
targetRng.Cells(4, 2).NumberFormat = "0.0000E+00"
' Add the filename to column "A"
targetRng.Offset(, -1).Resize(, 1).Value2 = _
Left(fileName, (InStrRev(fileName, ".", -1, vbTextCompare) - 1))
' Move the targetRng to the bottom of this range
Set targetRng = targetRng.Offset(targetRng.Rows.Count)
End If
Next
source.Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub