Reposition Table

Posted on May 17, 2004June 25, 2012 by Dick Kusleika

John is a self-proclaimed amateur and wants your advice. The purpose of this code is to find the table that starts somewhere in the first 50 rows and columns and reposition it so that it starts (top-left cell) in B5. I’m going to assume that there is nothing else on the worksheet except this table. John can correct me if I’m wrong.

For a = 1 To 50 For b = 1 To 50 If Not Cells(a, b) = "” And Flag = 1 Then Do While Cells(1, b) = "” 'Bring the data from wherever it is up to Row 1 Rows("1:1").Delete shift:=xlUp Loop ' Push data down from Row 1 to Row 5 For k = 1 To 4 Rows("1:1").Insert shift:=xlDown Next k 'Delete cells/shift left until the data comes into Column A Do While Cells(5, 1) = "” Columns("A:A”).Delete shift:=xlLeft Loop Flag = 0 End If Next b Next a

5 thoughts on “Reposition Table”

John says:

May 17, 2004 at 12:32 pm

Dick,

Correct. For conversation sake, this table is 10 columns wide and 200 rows long.

The object would be to come up with the most efficient code to put the upper left cell of table data in B5.

Thanks, John

Here’s my shot at it. A few assumptions: table must be contiguous and no other data can exist on the worksheet.

Sub MoveTableToB5()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng As Range
    Dim lRow As Long
    Dim nCol As Integer

    Application.ScreenUpdating = False

    With Sheet1
        On Error Resume Next
        Set rng1 = .Range(.Cells(1, 1), .Cells(50, _
         50)).SpecialCells(xlCellTypeConstants).Cells(1, 1)
        If Not rng1 Is Nothing Then
            Set rng2 = .Range(.Cells(1, 1), _
             rng1).SpecialCells(xlCellTypeFormulas).Cells(1, 1)
            If Not rng2 Is Nothing Then
                Set rng = rng2
            Else
                Set rng = rng1
            End If
        End If

        Set rng1 = Nothing
        Set rng2 = Nothing

        If Not rng Is Nothing Then
            lRow = rng.Row
            nCol = rng.Column

            If lRow > 1 Then .Range(.Cells(1, 1), _
             .Cells(Application.Max(lRow - 1, 1), _
             1)).EntireRow.Delete xlUp
            If nCol > 1 Then .Range(.Cells(1, 1), _
             .Cells(1, Application.Max(nCol - 1, _
             1))).EntireColumn.Delete xlToLeft
            .Range(.Cells(1, 1), .Cells(4, 1)).EntireRow.Insert xlDown
            .Range(.Cells(1, 1), .Cells(1, 1)).EntireColumn.Insert xlToRight
            Set rng = Nothing
        End If
    End With

    Application.ScreenUpdating = True
End Sub

Sub MoveTableToB5()

Dim rng1 As Range

Dim rng2 As Range

Dim rng As Range

Dim lRow As Long

Dim nCol As Integer

Application.ScreenUpdating = False

With Sheet1

On Error Resume Next

Set rng1 = .Range(.Cells(1, 1), .Cells(50, _

50)).SpecialCells(xlCellTypeConstants).Cells(1, 1)

If Not rng1 Is Nothing Then

Set rng2 = .Range(.Cells(1, 1), _

rng1).SpecialCells(xlCellTypeFormulas).Cells(1, 1)

If Not rng2 Is Nothing Then

Set rng = rng2

Else

Set rng = rng1

End If

Set rng1 = Nothing

Set rng2 = Nothing

If Not rng Is Nothing Then

lRow = rng.Row

nCol = rng.Column

If lRow > 1 Then .Range(.Cells(1, 1), _

.Cells(Application.Max(lRow - 1, 1), _

1)).EntireRow.Delete xlUp

If nCol > 1 Then .Range(.Cells(1, 1), _

.Cells(1, Application.Max(nCol - 1, _

1))).EntireColumn.Delete xlToLeft

.Range(.Cells(1, 1), .Cells(4, 1)).EntireRow.Insert xlDown

.Range(.Cells(1, 1), .Cells(1, 1)).EntireColumn.Insert xlToRight

Set rng = Nothing

End If

End With

Application.ScreenUpdating = True

End Sub

Dick says:

May 17, 2004 at 2:28 pm

If you create a worksheet and paste a table in it, this will work. The risk is that the worksheet isn’t new and has some remnants of a previous used range.

Sub RepoTable()

    With ActiveSheet
        .UsedRange.Cut .Range(“b5?)
    End With

End Sub
Jan Nordgreen says:

May 17, 2004 at 3:06 pm

This is my suggestion:

‘ task: move table with unknown location in range (1,1)-(maxrow,maxcol)
‘ to new location with upper-left corner given as newupperleft
‘ solution: locate range of table and cut and paste it to its new location

‘ parameters
maxrow = 50
maxcol = 50
newupperleft = “B5?

‘ scan the search area till the upper-left corner is found, i.e. toprow and leftcol
toprow = 0
Do
toprow = toprow + 1
leftcol = 0
Do
leftcol = leftcol + 1
Loop Until leftcol = maxcol Or Cells(toprow, leftcol) <> “”
Loop While Cells(toprow, leftcol) = “” And toprow < maxrow

If Cells(toprow, leftcol) = “” Then
MsgBox “No table found”
Exit Sub
End If

‘ scan right till we find rightcol
rightcol = leftcol
Do
rightcol = rightcol + 1
Loop While Cells(toprow, rightcol) <> “”
rightcol = rightcol – 1

‘ scan down till we find the bottomrow
bottomrow = toprow
Do
bottomrow = bottomrow + 1
Loop While Cells(bottomrow, leftcol) <> “”
bottomrow = bottomrow – 1

‘ cut and paste the table to its new location
Range(Cells(toprow, leftcol), Cells(bottomrow, rightcol)).Select
Selection.Cut
Range(newupperleft).Select
ActiveSheet.Paste

End Sub

—

Which of the suggested solutions is the best? It depends on the criteria used. I like mine because I understand it.
Dick, thanks for this spot for code critique!
John says:

May 17, 2004 at 5:10 pm

Well, I just tried Dick’s because it was the shortest. From a code perspective, less is better, IMHO.

As for the other suggestions (including mine) I’m not sure which would work the fastest.

One issue with mine is that it would not work with data pasted outside of the 50,50 limit.

Thanks for playing!
John