Hello Everyone,
I know VBA very basic level and created the below code to convert row data to a table. My code can crate a table currently but it is very slow and not dynamic enough to convert any data to a table. Can you please help?
1. Mostly Y-axis will be Y.0, Y.2, Y.4, Y.6, Y.8, but from time to time it changes Sometimes it can be Y.00, Y.25, Y.50, Y.75
2. Mostly raw data starts with Y.0 and continues, but sometimes it can start from another digit such as Y.2 or Y.6, etc.
Raw data can be over 8000 rows, hence below is not efficient at all, only saving time compared to manually copy-paste values to a table
Thanks for your help.
Code
Sheets("Sheet1").Activate
Set MyRange = Sheets("Sheet1").Range("A1")
Range(MyRange, MyRange.End(xlDown)).Select
kontur = Application.CountA(Selection) / 5 + 2
Sheets("Sheet1").Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=",", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Sheets("Sheet1").Columns("B:B").Select
Selection.NumberFormat = "0.00"
Sheets("Sheet1").Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Sheet1").Range("A3:A6").Select
Selection.Copy
Sheets("Sheet1").Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Sheet1").Range("A1").Select
For i = 2 To kontur
Sheets("Sheet1").Range("B" & i + 1).Select
Sheets("Sheet1").Range("B" & i + 1).Copy
Sheets("Sheet1").Range("C" & i).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet1").Range("B" & i + 2).Copy
Sheets("Sheet1").Range("D" & i).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet1").Range("B" & i + 3).Copy
Sheets("Sheet1").Range("E" & i).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet1").Range("B" & i + 4).Copy
Sheets("Sheet1").Range("F" & i).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets("Sheet1").Rows(i + 1).Select
Selection.Delete Shift:=xlUp
Sheets("Sheet1").Rows(i + 1).Select
Selection.Delete Shift:=xlUp
Sheets("Sheet1").Rows(i + 1).Select
Selection.Delete Shift:=xlUp
Sheets("Sheet1").Rows(i + 1).Select
Selection.Delete Shift:=xlUp
Next i
Display More