SudokuSolver Forum

Option Explicit



Private Const data_column      As String = "C"
Private Const first_data_row   As String = "5"



Public Sub ENXIO_27()

    Dim all_current_Excel_session_data_cells()      As Range
    Dim array_index                                 As Long
    Dim array_index_data_cell_with_smallest_value   As Long
    Dim data_cell                                   As Range
    Dim data_cell_with_smallest_value               As Range
    Dim Excel_session_workbook                      As Workbook
    Dim Excel_session_workbooks_worksheet           As Object
    Dim num_data_cells_with_empty_value             As Long
    Dim num_ordinary_worksheets                     As Long
    Dim sort_area                                   As Range



    ' Count the number of ordinary worksheets ("Worksheet" objects) in all Workbooks in this Excel session.
    For Each Excel_session_workbook In Application.Workbooks

        For Each Excel_session_workbooks_worksheet In Excel_session_workbook.Worksheets
            If TypeName(Excel_session_workbooks_worksheet) = "Worksheet" Then num_ordinary_worksheets = num_ordinary_worksheets + 1
        Next

    Next

    If num_ordinary_worksheets = 0 Then Exit Sub

    ' Set an element in "all_current_Excel_session_data_cells()" to the first "data_cell" in every "Worksheet" in all Workbooks in this Excel session.
    ReDim all_current_Excel_session_data_cells(1 To num_ordinary_worksheets)

    For Each Excel_session_workbook In Application.Workbooks

        For Each Excel_session_workbooks_worksheet In Excel_session_workbook.Worksheets

            If TypeName(Excel_session_workbooks_worksheet) = "Worksheet" Then
                ' Set next free element in "all_current_Excel_session_data_cells()" = "Excel_session_workbooks_worksheet.Range(data_column & first_data_row)"
                array_index = array_index + 1
                Set data_cell = Excel_session_workbooks_worksheet.Range(data_column & first_data_row)
                Set all_current_Excel_session_data_cells(array_index) = data_cell

                ' In "Excel_session_workbooks_worksheet" sort the area bound by Range("A" & first_data_row) AND "data_cell.SpecialCells(xlCellTypeLastCell)"
                ' using the values in "data_column" as keys.
                Set sort_area = Excel_session_workbooks_worksheet.Range(Excel_session_workbooks_worksheet.Range("A" & first_data_row), data_cell.SpecialCells(xlCellTypeLastCell))
                If Not (Application.Intersect(data_cell, sort_area) Is Nothing) Then Call sort_area.Sort(key1:=data_cell, Orientation:=xlSortColumns)
            End If

        Next

    Next

    ' Remove all duplicates all in all Worksheets in all Workbooks in this Excel session.
    Application.ScreenUpdating = False

    Do While True
        num_data_cells_with_empty_value = 0
        array_index_data_cell_with_smallest_value = 1
        Set data_cell_with_smallest_value = all_current_Excel_session_data_cells(1)

        ' Find the "data_cell" with the smallest value of "all_current_Excel_session_data_cells()".
        For array_index = 1 To num_ordinary_worksheets

            If all_current_Excel_session_data_cells(array_index).Value = vbNullString Then
                num_data_cells_with_empty_value = num_data_cells_with_empty_value + 1
            ElseIf data_cell_with_smallest_value.Value = vbNullString Then
                array_index_data_cell_with_smallest_value = array_index
                Set data_cell_with_smallest_value = all_current_Excel_session_data_cells(array_index)
            ElseIf all_current_Excel_session_data_cells(array_index).Value < data_cell_with_smallest_value.Value Then
                array_index_data_cell_with_smallest_value = array_index
                Set data_cell_with_smallest_value = all_current_Excel_session_data_cells(array_index)
            End If

        Next

        ' Test if done.
        If num_data_cells_with_empty_value = num_ordinary_worksheets Then Exit Do

        ' Increase "all_current_Excel_session_data_cells(array_index_data_cell_with_smallest_value)" one Row, so that it does not get deleted and the algorithm advances.
        Set all_current_Excel_session_data_cells(array_index_data_cell_with_smallest_value) = data_cell_with_smallest_value.Offset(RowOffset:=1, ColumnOffset:=0)

        ' Remove all Rows in all Worksheets in all Workbooks in this Excel session whose "current_data_cell.Value = data_cell_with_smallest_value.Value".
        For array_index = 1 To num_ordinary_worksheets

            If all_current_Excel_session_data_cells(array_index).Value = data_cell_with_smallest_value.Value Then
                Set data_cell = all_current_Excel_session_data_cells(array_index)

                If data_cell.Worksheet Is data_cell_with_smallest_value.Worksheet Then
                    Set all_current_Excel_session_data_cells(array_index) = data_cell.Offset(RowOffset:=-1, ColumnOffset:=0)
                Else
                    Set all_current_Excel_session_data_cells(array_index) = data_cell.Offset(RowOffset:=1, ColumnOffset:=0)
                End If

                Call data_cell.Worksheet.Rows(data_cell.Row).Delete
            End If

        Next

    Loop

    Application.ScreenUpdating = True
End Sub