i would like a code for autosort left to rigth

A

Anthony

i would like a code for autosort left to rigth
eg 1-3-5-7-3-8-4- "- represents blank cell"
1-3-3-4-5-7-8- leaving blank where they are
 
J

Jacob Skaria

Dear Anthony

Try the below code and feedback which works on Row 1.


Sub SortWOBlanks()
Dim lngCol As Long
Dim lngCount As Long
Dim lngLastCol As Long
Dim varTemp As Variant
Dim arrTemp As Variant

Application.ScreenUpdating = False
lngLastCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
varTemp = Range("A1", Cells(1, lngLastCol))
Range("A1", Cells(1, lngLastCol)).Sort Key1:=Range("A1")
lngCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
arrTemp = Range("A1", Cells(1, lngCol))
Range("A1", Cells(1, lngLastCol)) = varTemp
For lngCol = 1 To lngLastCol
If Cells(1, lngCol) <> "" Then
lngCount = lngCount + 1
Cells(1, lngCol) = arrTemp(1, lngCount)
End If
Next
Application.ScreenUpdating = True

End Sub

If this post helps click Yes
 
J

Jacob Skaria

Oops. I missed to mention the sort order.. Modified the code so as to call
from code by passing the row to be sorted... such as SortWOBlanks 1 will sort
the first row.

Sub SortWOBlanks(lngRow As Long)
Dim lngCol As Long
Dim lngCount As Long
Dim lngLastCol As Long
Dim varTemp As Variant
Dim arrTemp As Variant

Application.ScreenUpdating = False
lngLastCol = Cells(lngRow, Columns.Count).End(xlToLeft).Column
varTemp = Range(Cells(lngRow, 1), Cells(lngRow, lngLastCol))
Range(Cells(lngRow, 1), Cells(lngRow, lngLastCol)).Sort _
Key1:=Range("A" & lngRow), Orientation:=xlLeftToRight
lngCol = ActiveSheet.Cells(lngRow, Columns.Count).End(xlToLeft).Column
arrTemp = Range(Cells(lngRow, 1), Cells(lngRow, lngCol))
Range(Cells(lngRow, 1), Cells(lngRow, lngLastCol)) = varTemp
For lngCol = 1 To lngLastCol
If Cells(lngRow, lngCol) <> "" Then
lngCount = lngCount + 1
Cells(lngRow, lngCol) = arrTemp(1, lngCount)
End If
Next
Application.ScreenUpdating = True

End Sub

If this post helps click Yes
 
Top