Move data in rows ignoring blanks

[mmartin79]

Hi everyone,

I'm looking for a macro to remove the blanks between two set of data in every single row.

It's always two cells with data in every row, but the first data in the row should be fixed.

For example, in row 2 of the attached file, I have data in column A and column G, I want to move the data of column G to column B. But in row 3 the data si in column B and I, so I want to move it to column C, and so on.

Thank you in advance for your help. Move between rows.xlsx

[tigeravatar]

mmartin79,

Welcome to the forum!
Give this a try:

Sub tgr()
    
    Dim rngDel As Range
    Dim rngGap As Range
    Dim rIndex As Long
    Dim strAddress As String
    
    On Error Resume Next
    For rIndex = 2 To Cells.Find("*", Range("A1"), xlValues, , , xlPrevious).Row
        strAddress = Split(Rows(rIndex).SpecialCells(xlCellTypeConstants).Address, ",")(1)
        If Len(strAddress) > 0 Then
            Set rngGap = Range(Range(strAddress).End(xlToLeft).Offset(, 1), Range(strAddress).Cells(1).Offset(, -1))
            If rngDel Is Nothing Then
                Set rngDel = rngGap
            Else
                Set rngDel = Union(rngDel, rngGap)
            End If
            Set rngGap = Nothing
            strAddress = vbNullString
        End If
    Next rIndex
    On Error GoTo 0
    
    If Not rngDel Is Nothing Then
        rngDel.Delete xlToLeft
        Set rngDel = Nothing
    End If
    
End Sub

[mmartin79]

Thanks tigeravatar, works great!