Remove blank cells to left if condition

[peterwmartin]

Hi all,
Please I need some help.
I have four columns, A & B are blank, C has numbers and words, D has a description if the column before it has a word.
What I am trying to do is if column C contains a word or string then move it and its description to column A & B.
I have tried if cell contains a word change its offset (0,-2) or remove the blanks by using special cells.
Nothing I am doing gets the desired result, any help or pointers would be appreciated.

[p45cal]

try:

Sub blah()
For Each are In Columns(3).SpecialCells(xlCellTypeConstants, 2).Areas
  are.Resize(, 2).Cut are.Offset(, -2)
Next are
End Sub

If this fails then post a sample file.

[Paul_Hossler]

Try this, sample WB attached

Option Explicit

Sub Macro1()
    Dim rData As Range, rArea As Range

    On Error Resume Next
    Set rData = Columns("C:D").SpecialCells(xlCellTypeConstants, 2)
    On Error GoTo 0
    If rData Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
    For Each rArea In rData.Areas
        Call rArea.Copy(Cells(rArea.Row, 1))
    Next
    
    Application.CutCopyMode = False
    
    Application.ScreenUpdating = True
End Sub