Moving specific cells to the right

[iosiflupis]

Hello all,

I have a problem that I am trying to solve. I have a table with over 770K rows. These rows contain data about the weather at different times of each day. In the fourth column (Type) there is a mix of AUTO and integers. The integers are supposed to be in the Wind Spd & Dir column. I cannot figure out how to move specific cells to the right. The cells with AUTO should remain where they are, and the integers should move one cell to the right.

The ultimate goal is to have the columns lined up so that I can determine MAX, MIN, and AVG for each day. But to do that I will need to have all columns with the same data.

I can work with VBA or formula.

Thank you all.

 

[Z51]

If they were actually integers (numeric), I think you could use a mix of SpecialCells and Insert>shift right, but as it appears to be all text strings, a loop might be needed (unless someone has a better idea).

Sub iosiflupis()
Dim lastrow As Long, ce As Range
lastrow = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row

For Each ce In Sheets("Sheet1").Range("D2:D" & lastrow)
    If ce.Value <> "AUTO" Then ce.Insert xlToRight
Next ce
End Sub

Change Sheet1 to your sheet name, of course. You also may want to add Application.ScreenUpdating = False before the ForNext loop, and then Application.ScreenUpdating = True after the loop.

 

[Peter_SSs]

That is a very big range and a lot of individual rows to partly move right. I think this should be massively faster than looping each row, but be patient as it may take some seconds to complete.

Sub Move_Right()
  Dim lc As Long
  
  Application.ScreenUpdating = False
  Columns(1).Insert
  lc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  With Range("A1").Resize(Range("B" & Rows.Count).End(xlUp).Row, lc)
    .Columns(1).Value = Evaluate("row(" & .Columns(1).Address & ")")
    .Columns(5).Replace What:="AUTO", Replacement:=1, LookAt:=xlWhole
    .Sort Key1:=.Columns(5), Order1:=xlAscending, Header:=xlYes
    With .Columns(5)
      .SpecialCells(xlConstants, xlTextValues).Insert Shift:=xlToRight
      .Replace What:=1, Replacement:="AUTO", LookAt:=xlWhole
    End With
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
  End With
  Columns(1).Delete
  Application.ScreenUpdating = True
  MsgBox "Done"
End Sub

 

[iosiflupis]

Gentlemen, Thank you for the replies. I went with the second solution. It ran for about 45 seconds. But, for over 770K rows this was extremely speedy!

 

[Peter_SSs]

Glad it worked sufficiently well for you.

I forgot to ask if you might have a lot of formulas or other code in the worksheet/workbook. If you have to do this task again/regularly, it would be worth trying with these added lines of code to see if speed is improved any further. They certainly won't do any harm.

Sub Move_Right()
  Dim lc As Long
  
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Columns(1).Insert
  lc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  With Range("A1").Resize(Range("B" & Rows.Count).End(xlUp).Row, lc)
    .Columns(1).Value = Evaluate("row(" & .Columns(1).Address & ")")
    .Columns(5).Replace What:="AUTO", Replacement:=1, LookAt:=xlWhole
    .Sort Key1:=.Columns(5), Order1:=xlAscending, Header:=xlYes
    With .Columns(5)
      .SpecialCells(xlConstants, xlTextValues).Insert Shift:=xlToRight
      .Replace What:=1, Replacement:="AUTO", LookAt:=xlWhole
    End With
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
  End With
  Columns(1).Delete
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  MsgBox "Done"
End Sub

 

[iosiflupis]

Actually, I was only going to run it once, as the data was static. I was going to be using this data against airline arrival and departure data to compare for cancellation reasons.

 

[Peter_SSs]

OK, no problem then, 45 seconds is fine for a once-off.