BeachBum
05-27-2020, 06:00 PM
Hi All,
I have a large amount of data spread across multiple columns and rows. Unfortunately due to the output of the original program the data is output using commas as both decimal places and as separation devices. An image of the data is below:
26747
Essentially the text columns should be changed to individual numbers that can be worked with, as per the below image:
26748
As the commas are used as decimal separators as well as text separators, using the built in excel "text to column" is very difficult. I have created a vba code that separates the text strings, changes the commas to decimal separators, deletes the trailing decimal separator and then saves as a value. However this is very inefficient as it uses a "for each cell" loop. Can anyone suggest any improvements to my code to make it operate faster? Or if there is any bit of built in functionality that I may have missed that may assist? My code is below. I have also uploaded a sample set of data. It is not all the columns or rows but you get the idea of what it looks like to begin with.
Sub Data_Separation()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim rng As Range, cell As Range
Dim myStr As String
ActiveSheet.Range("A2:A" & LastRow).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 9), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 9), Array(9, 9), Array(10, 9), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1)), _
TrailingMinusNumbers:=True
Set rng = ActiveSheet.UsedRange
rng.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
For Each cell In rng
myStr = cell
If Right(myStr, 1) = "." Then
cell = Left(myStr, Len(myStr) - 1)
cell.NumberFormat = "0.000"
cell.Value = cell.Value
End If
Next cell
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I have a large amount of data spread across multiple columns and rows. Unfortunately due to the output of the original program the data is output using commas as both decimal places and as separation devices. An image of the data is below:
26747
Essentially the text columns should be changed to individual numbers that can be worked with, as per the below image:
26748
As the commas are used as decimal separators as well as text separators, using the built in excel "text to column" is very difficult. I have created a vba code that separates the text strings, changes the commas to decimal separators, deletes the trailing decimal separator and then saves as a value. However this is very inefficient as it uses a "for each cell" loop. Can anyone suggest any improvements to my code to make it operate faster? Or if there is any bit of built in functionality that I may have missed that may assist? My code is below. I have also uploaded a sample set of data. It is not all the columns or rows but you get the idea of what it looks like to begin with.
Sub Data_Separation()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim rng As Range, cell As Range
Dim myStr As String
ActiveSheet.Range("A2:A" & LastRow).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 9), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 9), Array(9, 9), Array(10, 9), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1)), _
TrailingMinusNumbers:=True
Set rng = ActiveSheet.UsedRange
rng.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
For Each cell In rng
myStr = cell
If Right(myStr, 1) = "." Then
cell = Left(myStr, Len(myStr) - 1)
cell.NumberFormat = "0.000"
cell.Value = cell.Value
End If
Next cell
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub