-1

I have a VBA that selects specific columns to create a chart. I was having an issue where certain columns would be omitted from the chart and I didn't know why. After troubleshooting, I found that once the omitted columns were converted from Text to Column that they worked. Any idea why?

I have tried to convert every column from Text to Column using a VBA but I get an error

...can only convert one column at a time...

Doing one at a time would take forever as I have hundreds of columns to do. Is there a VBA that can quickly process this?

Here is my code for creating the charts if it helps:

Sub Graph2()

'   Graphs for monitoring

    Dim my_range As Range, t, co As Shape 

    t = Selection.Cells(1, 1).Value & " - " & ActiveSheet.Name

    Dim OldSheet As Worksheet
    Set OldSheet = ActiveSheet

    Set my_range = Union(Selection, ActiveSheet.Range("A:A"))

    Set co = ActiveSheet.Shapes.AddChart2(201, xlLine) 'add a ChartObject

    With co.Chart
        .FullSeriesCollection(1).ChartType = xlXYScatter
        .FullSeriesCollection(1).AxisGroup = 1
        .FullSeriesCollection(2).ChartType = xlLine
        .FullSeriesCollection(2).AxisGroup = 1
        .SetSourceData Source:=my_range
        'highlight final dot of data
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count - 1).ApplyDataLabels Type:=xlShowValue
        .HasTitle = True
        .ChartTitle.Text = t
        'ResolveSeriesnames co.Chart
        .Location Where:=xlLocationAsObject, Name:="Graphs"

    End With

    OldSheet.Activate
End Sub
Zacchini
  • 143
  • 13

1 Answers1

0

Here is my answer.

Purpose:
Take a list of columns and apply the Range.TextToColumns method one by one as fast as possible.

Algorithm:
1. Create an array of needed columns;
2. Go through this array column by column and:
- 2.1 Check whether there is any data to the right;
- 2.2 Make sure to insert enough columns to preserve data on the right;
- 2.3 Apply Range.TextToColumns method.

Tested on:
Range of 200 rows and 200 columns filled with "Sample Data" text and randomly inserted "Sample Data Data Data Data Data" text to test with different delimiters quantity. Used space as delimiter:
sample

Code:

Sub SplitColumns()
Dim rToSplit() As Range, r As Range
Dim i As Long, j As Long, k As Long
Dim sht As Worksheet
Dim delimiter As String
Dim consDelimiter As Boolean
Dim start As Single, total As Single
Dim delimitersCount() As Long

'========================== TESTING STUFF =======================================
' set working sheet
Set sht = ThisWorkbook.Sheets("Sheet2")

' re-create sample data (it is changed on each macro run)
sht.Cells.Clear
ThisWorkbook.Sheets("Sheet2").Cells.Copy Destination:=sht.Cells(1, 1)

' timer for testing purposes - start point
start = Timer
'======================== END OF TESTING STUFF ===================================

' Set the delimiter
' I've used space
delimiter = " "

' assign a ConsecutiveDelimiter state
consDelimiter = False

Application.ScreenUpdating = False

'=================== CREATING A LIST OF COLUMNS FOR SPLIT ========================
' create an array of columns to be changed
' at this sample I take all 200 columns
' you have to assign your own range which is to be splitted
With sht
    For i = .Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
        ' add columns to an array
        If Not .Cells(1, i) = "" Then
            ReDim Preserve rToSplit(j)
            Set rToSplit(j) = Range(.Cells(1, i), .Cells(Rows.Count, i).End(xlUp))
            j = j + 1
        End If
    Next
End With
'=============== END OF CREATING A LIST OF COLUMNS FOR SPLIT ======================




'============================= PERFORMING SPLIT ===================================
' go through each column in array
' from left to right, because
' there may be a need to insert columns
For j = LBound(rToSplit) To UBound(rToSplit)

    ' check whether there is any data on the right from the top cell of column
    ' note - I'm checking only ONE cell
    If Not rToSplit(j).Cells(1, 1).Offset(0, 1) = "" Then
        ' creating another array:
        ' purpose - check cells in column
        ' and count quantity of delimiters in each of them
        ' quantity of delimiters = quantity of columns to insert
        ' in order not to overwrite data on the right
        For Each r In rToSplit(j).Cells
            ReDim Preserve delimitersCount(k)
            delimitersCount(k) = UBound(Split(r.Text, delimiter))
            k = k + 1
        Next

        ' get the maximun number of delimiters (= columns to insert)
        For i = 1 To WorksheetFunction.Max(delimitersCount)
            ' and insert this quantity of columns
            rToSplit(j).Cells(1, 1).Offset(0, 1).EntireColumn.Insert
        Next

        ' split the column, nothing will be replaced
        rToSplit(j).TextToColumns Destination:=rToSplit(j).Cells(1, 1), ConsecutiveDelimiter:=consDelimiter, Tab:=False, Semicolon:=False, Comma:=False, _
                                                                        Space:=False, Other:=True, OtherChar:=delimiter
    Else
        ' here I just split column as there is no data to the right
        rToSplit(j).TextToColumns Destination:=rToSplit(j).Cells(1, 1), ConsecutiveDelimiter:=consDelimiter, Tab:=False, Semicolon:=False, Comma:=False, _
                                                                        Space:=False, Other:=True, OtherChar:=delimiter
    End If
    ' clear the delimiters count array
    Erase delimitersCount
' go to next column
Next

' done
'========================= END OF PERFORMING SPLIT ===================================

' timer for testing purposes - time difference in seconds
total = Timer - start

Debug.Print "Total time spent " & total & " seconds."

Application.ScreenUpdating = True
End Sub

Hope that helps.

Vitaliy Prushak
  • 1,057
  • 8
  • 13