One of my professional software I use everyday provides analysis results in *.csv format from which I need to extract data. I have written a script that first converts from text to columns, and then takes out the data I need rearranging it the way I want. My problem is that it is not very fast while I will need to use it a lot. I am pretty sure it can be made more efficient with proper iterators but everything else I have tried I hit the wall somewhere along the way.
Now to the specifics. Here is how the Excel data looks like after I transform from text to column and delete some columns I know do not contain any interesting data.
Two columns are remaining:
xxx xxx xxx . . KnownText1 KnownText2 Data1.1 Data1.2 Data1.3 Data1.4 . . Data1.m Data1.n xxx xxx xxx . Knowntext1 Knowntext2 Data2.1 Data2.2 Data2.3 Data2.4 . . Data2.k Data2.l xxx xxx
xxx can be anything.
Knowntext1 is always the same and shows the start of a new data block that needs to be captured. Number of blocks can vary as well as the number of rows within each block.
I want my data to become:
Knowntext1 Knowntext2 Knowntext1 Knowntext2 ... Data1.1 Data1.2 Data2.1 Data2.2 ... Data1.3 Data1.4 Data2.3 Data2.4 ... ... Data1.m Data1.n Data2.k Data2.l ...
Here is my VBA code. Any ideas on how to make an efficient iterator to do the same?
Sub CopyFromCSV() Dim RngData As Range Dim RngCopy As Range Dim rCell As Range Dim nTrims As Integer Dim nDrafts As Integer Dim maxDrafts As Integer ' Transform text to columns by "," seperator Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(1, 1), TrailingMinusNumbers:=True ' Removes the " " thousand seperator from the displacement column Columns("A:A").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ' Delete columns other than those containing information of Displacement and MaxVCG Columns("B:B").Select Selection.Delete Shift:=xlToLeft Columns("C:Z").Select Selection.Delete Shift:=xlToLeft ' Find the actual used range which we want to loop through Set RngData = ActiveSheet.UsedRange ' Initialise variables for number of trim groups and the maximum number of drafts in all trim groups nTrims = 0 maxDrafts = 0 With RngData 'Loop through all cells in first column For Each rCell In .Columns(1).Cells ' If Value is "Intact Displ(MT)", a new trim group is detected If rCell.Cells(1, 1).Value = "Intact Displ(MT)" Then nTrims = nTrims + 1 'Number of trims groups incremented nDrafts = 1 'Number of drafts in this trim group initialised to 1 Set RngCopy = rCell.Resize(1, 2) 'Initiate the range that will include data for this trim group ' If Value is numeric, it means the row contains data for the initiated trim group ElseIf IsNumeric(rCell.Cells(1, 1).Value) Then nDrafts = nDrafts + 1 'Number of drafts in the trim group incremented Set RngCopy = RngCopy.Resize(nDrafts, 2) 'Range to be copied is updated If nDrafts > maxDrafts Then 'In case not all trim groups have the same amount of drafts, we need to set maxDrafts to know the size of the final selection maxDrafts = nDrafts End If ' If another type of data is detected, the range to be copied is frozen and copied at the top of the sheet, after the last column ' Test on nTrims > 0 necessary to avoid the action to occur before any valuable data is detected ElseIf Not (IsNumeric(rCell.Cells(1, 1).Value)) And nTrims > 0 Then RngCopy.Copy Cells(1, 2 * nTrims + 1).Select ActiveSheet.Paste End If Next rCell End With ' Relevant data was copied after last column ' First two columns of original data can be deleted Columns("A:B").Select Selection.Delete Shift:=xlToLeft ' Numeric data of the transformed table is selected and sent to clipboard ready to paste in global spreadsheet Range(Cells(2, 1), Cells(maxDrafts, 2 * nTrims)).Select Selection.Copy End Sub