Insert, Merge, and Text To Columns

[seattletimebandit]

Hey All,

Hope everyone is staying safe and healthy. Lots of time on our hands to play with some code!

Trying to work something out here. I have a table with nth columns, with two header rows. Got a macro to insert a blank column to the right of each data column by selecting the range with a prompt.

Then I have a macro to merge each header (in row 1 and in row 2), centered across the data column and the adjacent newly inserted empty column. Now I need to do a Text to Column function. My data generally looks like this:
0.20 U or 47.1 or a dash "-", or a blank cell. (there is either a "U", or there is not, all numbers with "U's" are space delimited, and/or there could be no data, blank cells or probably a dash "-", so just need to ignore those, it's all about moving the "U").

So after inserting a blank column, merging the two headers over the two columns, I need to split the data number (keeping in cell) and moving the "U" to the adjacent blank cell. I toyed around with a macro I found splitting the string, but if there is no "U", the data moved to the adjacent empty cell.

Here are examples of the table before and after:




Is there a way to loop through a user prompted selected Range and perform the Text to Columns? I know Excel's feature in the Ribbon only allows for one column at a time. Just wondering if I can loop to through nth columns and nth rows, based on selecting the range of my choice.

The goal is to have all 3 macros fire from the same module: insert every other column (based on user selecting range), merge top two headers across each set of paired columns (based on user selecting range), and splitting the "U" from the data column into the newly inserted blank column of cells.

Thanks in advance!

Here is the inserting blank columns code:

Sub InsertAlternateBlankColumns()
Dim rng As Range
Dim CountCol As Integer
Dim i As Integer

Set rng = Selection

    CountCol = rng.EntireColumn.Count
        For i = 1 To CountCol
            ActiveCell.EntireColumn.Insert
            ActiveCell.Offset(0, 2).Select
        Next i
End Sub

And this is for merging the two headers, but currently I have to manually change: Set RgToMerge = Range(Cells(1, i), Cells(1, i + 1)) to Set RgToMerge = Range(Cells(2, i), Cells(2, i + 1))
I want to have the user select the range. Just not there yet, getting stuck on the Text to Columns bit.

Sub MergeHeaders()
Dim RgToMerge As Range

  Application.DisplayAlerts = False

  For i = 1 To ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column Step 2
    Set RgToMerge = Range(Cells(1, i), Cells(1, i + 1))
    With RgToMerge
      .Merge
      .HorizontalAlignment = xlCenterAcrossSelection
      .VerticalAlignment = xlCenter
    End With
  Next i
End Sub

And this is what i have for Text to Columns, but only be selection each column one at a time:

Sub TextToColumnsRangeSelection()
    On Error Resume Next
    Dim MySelection As Range

    Application.DisplayAlerts = False
    Set MySelection = Application.InputBox(Prompt:="Please select your range", Title:="Select Range", Type:=8)

    MySelection.TextToColumns _
    Destination:=MySelection, _
    DataType:=xlDelimited, _
    TextQualifier:=xlTextQualifierDoubleQuote, _
    ConsecutiveDelimiter:=True, _
    Tab:=False, _
    Semicolon:=False, _
    Comma:=False, _
    Space:=True, _
    Other:=False
End Sub