VBA: shift data in a range towards left

[Nelson78]

Hello everybody.

I have a variable range defined as set = range1 in which there are empty cells.

I need, for each row in the range, to shift all not empty cells toward the left.
The operation has not to impact the columns on the right of the range, because they contains other data.
For example, range C3:L28, column from N to the right have to remain at their place.

How can I manage the issue?

Thank's.

 

[Nelson78]

Can you post your data as an excel file rather than a picture.

Probably not.

https://imgur.com/a/qpjIGWT

 

[MickG]

Try "Box.com", or "DropBox" (free)

 

[Nelson78]

Wrong message.

 

[Nelson78]

Try "Box.com", or "DropBox" (free)

There it is.



https://www.dropbox.com/s/75lj3zf7246kmgc/example_zz.xlsx?dl=0

 

[MickG]

Try this:-
NB:- Alter range a top of Code to suit.!!

[COLOR="Navy"]Sub[/COLOR] MG17Jul54
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("D2:CS750")
Application.ScreenUpdating = False
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Rows
    ReDim Ray(1 To Rng.Columns.Count)
    c = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rw [COLOR="Navy"]In[/COLOR] Dn.Cells
        [COLOR="Navy"]If[/COLOR] Not IsEmpty(Rw.Value) [COLOR="Navy"]Then[/COLOR]
           c = c + 1
           [COLOR="Navy"]If[/COLOR] IsDate(Rw.Value) [COLOR="Navy"]Then[/COLOR]
                Ray(c) = CDate(Rw.Value)
            [COLOR="Navy"]Else[/COLOR]
                Ray(c) = Rw.Value
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Rw
[COLOR="Navy"]If[/COLOR] c > 0 [COLOR="Navy"]Then[/COLOR]
    Dn.Cells.ClearContents
    Dn(1).Resize(, c).Value = Ray
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Application.ScreenUpdating = True
MsgBox "End"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Nelson78]

Try this:-
NB:- Alter range a top of Code to suit.!!

[COLOR="Navy"]Sub[/COLOR] MG17Jul54
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("D2:CS750")
Application.ScreenUpdating = False
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Rows
    ReDim Ray(1 To Rng.Columns.Count)
    c = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rw [COLOR="Navy"]In[/COLOR] Dn.Cells
        [COLOR="Navy"]If[/COLOR] Not IsEmpty(Rw.Value) [COLOR="Navy"]Then[/COLOR]
           c = c + 1
           [COLOR="Navy"]If[/COLOR] IsDate(Rw.Value) [COLOR="Navy"]Then[/COLOR]
                Ray(c) = CDate(Rw.Value)
            [COLOR="Navy"]Else[/COLOR]
                Ray(c) = Rw.Value
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Rw
[COLOR="Navy"]If[/COLOR] c > 0 [COLOR="Navy"]Then[/COLOR]
    Dn.Cells.ClearContents
    Dn(1).Resize(, c).Value = Ray
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Application.ScreenUpdating = True
MsgBox "End"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

Yes, perfect.

Thank's.

 

[MickG]

You're welcome