ExcelProg

[farzinmonsef]

ExcelProgram

[farzinmonsef]

' '--------------------- '| a1 | b1 | c1 | d1 | '--------------------- '|    |    |    |    | '--------------------- '| a2 | b2 | c2 | d2 | '--------------------- ' ' Move lines to top of blank lines in SELECTION '--------------------- '| a1 | b1 | c1 | d1 | '--------------------- '| a2 | b2 | c2 | d2 | '--------------------- '|    |    |    |    | '--------------------- '========================================================= Farzin Monsef '========================================================= July 2015 Sub MoveNotBlankCells()

Dim i As Long
Dim j As Long
Dim k As Long
Dim buf As String
buf = ""
Dim lastBlankRow As Integer
Dim swBlankLineFound As Boolean
lastBlankRow = -1

If (Selection.Rows.Count >= 65536) And (Selection.Columns.Count >= 256) Then
    MsgBox "Error: Select something first !", , "Farzin Monsef - Merrill Lynch     "
Else
    For i = Selection.Rows(1).Row To Selection.Rows.Count + Selection.Rows(1).Row - 1
        swBlankLineFound = True
        For k = 1 To Selection.Columns.Count
            If Trim(CStr(Cells(i, Selection.Columns(k).Column).Value)) <> "" Then
                swBlankLineFound = False
                Exit For
            End If
        Next k

        If Not swBlankLineFound Then
            If lastBlankRow <> -1 Then
                For j = 1 To Selection.Columns.Count
                    Cells(lastBlankRow, Selection.Columns(j).Column).Value = Cells(i, Selection.Columns(j).Column).Value
                    Cells(i, Selection.Columns(j).Column).Value = ""
                Next j
                i = lastBlankRow
                lastBlankRow = -1
                GoTo ContinueLoop
            End If
        Else
            If lastBlankRow = -1 Then
                lastBlankRow = i
            End If
        End If

ContinueLoop: Next i MsgBox "Move Not-Blank Cells is Done", , "Farzin Monsef - Merrill Lynch " End If End Sub

[farzinmonsef]

'----------------- '| a | b | c | d | '----------------- '| a | b | c | d | '----------------- '| a | b | c | d | '----------------- ' ' gather all columns to top of SELECTION '  /\  /\  /\  /\ '  ||  ||  ||  || ' '------------------------- '| aaa | bbb | ccc | ddd | '------------------------- '|     |     |     |     | '------------------------- '|     |     |     |     | '------------------------- ' '========================================================= Farzin Monsef '========================================================= July 2015 Sub concatColumns() Dim seperator As String: seperator = Chr(10) '" " Dim i As Long Dim j As Long Dim buf As String buf = "" If (Selection.Rows.Count >= 65536) And (Selection.Columns.Count >= 256) Then MsgBox "Error: Select something first !", , "Farzin Monsef - Merrill Lynch " Else For j = 1 To Selection.Columns.Count For i = Selection.Rows(1).Row To Selection.Rows.Count + Selection.Rows(1).Row - 1

            If Trim(CStr(Cells(i, Selection.Columns(1).Column + j - 1).Value)) <> "" Then
                buf = buf + IIf(buf <> "", seperator, "") + CStr(Cells(i, Selection.Columns(1).Column + j - 1).Value) 'cell.Text
            End If
            Cells(i, Selection.Columns(1).Column + j - 1).Value = ""
        Next i
        Cells(Selection.Rows(1).Row, Selection.Columns(1).Column + j - 1).Value = buf
        buf = ""
    Next j
    MsgBox "Concat Selection is Done", , "Farzin Monsef - Merrill Lynch     "
End If

End Sub

[farzinmonsef]

'----------------- '| a | b | c | d | '----------------- '| a | b | c | d | '----------------- '| a | b | c | d | '----------------- ' ' gather all rows to firt column of SELECTION ' <====== ' '----------------- '| abcd |  |  |  | '----------------- '| abcd |  |  |  | '----------------- '| abcd |  |  |  | '----------------- ' '========================================================= Farzin Monsef '========================================================= July 2015 Sub concatEachRow() Dim seperator As String: seperator = Chr(10) '" " Dim i As Long Dim j As Long Dim buf As String buf = "" If (Selection.Rows.Count >= 65536) And (Selection.Columns.Count >= 256) Then MsgBox "Error: Select something first !", , "Farzin Monsef - Merrill Lynch " Else For i = Selection.Rows(1).Row To Selection.Rows.Count + Selection.Rows(1).Row - 1 For j = 1 To Selection.Columns.Count

            If Trim(CStr(Cells(i, Selection.Columns(1).Column + j - 1).Value)) <> "" Then
                buf = buf + IIf(buf <> "", seperator, "") + Trim(CStr(Cells(i, Selection.Columns(1).Column + j - 1).Value)) 'cell.Text
            End If
            Cells(i, Selection.Columns(1).Column + j - 1).Value = ""
        Next j
        Cells(i, Selection.Columns(1).Column).Value = buf
        buf = ""
    Next i
    MsgBox "Concat Selection is Done", , "Farzin Monsef - Merrill Lynch     "
End If

End Sub

[farzinmonsef]

' '--------------------- '| a1 | b1 | c1 | d1 | '--------------------- '|    |    |    |    | '--------------------- '| a2 | b2 | c2 | d2 | '--------------------- ' ' delete blank lines in SELECTION '--------------------- '| a1 | b1 | c1 | d1 | '--------------------- '| a2 | b2 | c2 | d2 | '--------------------- ' '========================================================= Farzin Monsef '========================================================= July 2015 Sub DeleteBlankRows()

Dim i As Long
Dim j As Long
Dim k As Long
Dim buf As String
buf = ""
Dim lastBlankRow As Integer
Dim swBlankLineFound As Boolean
Dim swLookAhead As Boolean
Dim DeletedRows
DeletedRows = 0
lastBlankRow = -1

If (Selection.Rows.Count >= 65536) And (Selection.Columns.Count >= 256) Then
    MsgBox "Error: Select something first !", , "Farzin Monsef - Merrill Lynch     "
Else
    Dim maxNoRows: maxNoRows = Selection.Rows.Count
    If (Selection.Rows.Count < 65536) And (Selection.Columns.Count >= 256) Then
        For k = 1 To 256
            If Trim(CStr(Cells(Selection.Rows(1).Row, Selection.Columns(k).Column).Value)) = "" Then
                Range(Cells(Selection.Rows(1).Row, Selection.Columns(1).Column), Cells(Selection.Rows(1).Row + maxNoRows - 1, Selection.Columns(k - 1).Column)).Select
                Exit For
            End If
        Next k

    End If

    For i = Selection.Rows(1).Row To maxNoRows + Selection.Rows(1).Row - 1
        swBlankLineFound = True
        For k = 1 To Selection.Columns.Count
            If Trim(CStr(Cells(i, Selection.Columns(k).Column).Value)) <> "" Then
                swBlankLineFound = False
                Exit For
            End If
        Next k

        If swBlankLineFound Then
            swLookAhead = False
            For j = i + 1 To maxNoRows + Selection.Rows(1).Row - 1
                For k = 1 To Selection.Columns.Count
                    If Trim(CStr(Cells(j, Selection.Columns(k).Column).Value)) <> "" Then
                        swLookAhead = True
                        GoTo DeleteRow
                    End If
                Next k
            Next j

DeleteRow: If swLookAhead Then Rows(i).Delete maxNoRows = maxNoRows - 1 i = i - 1 Else Exit For End If End If ContinueLoop: Next i Range(Cells(Selection.Rows(1).Row, Selection.Columns(1).Column), Cells(Selection.Rows(1).Row + maxNoRows - 1, Selection.Columns(Selection.Columns.Count).Column)).Select MsgBox "Remove Blank Lines is Done", , "Farzin Monsef - Merrill Lynch " End If End Sub