Hierarchy Macro

[Guest]

I have the following Excel table:

x = blank cells

A B C D E F G H
1 x x x x x x M R
2 x x x x x M R T
3 x x x x M R T S
4 x x x M R T S Y
5 x x M R T S Y N
6 x M R T S Y N Q
7 M R T S Y N Q W
8 x x x x M R T S

I want to have Excel see the blanks (if there is one) and place the M in
column A and any cells up to column H to be back filled with the existing
data. Please see what I want the above table to look like after macro:

A B C D E F G H
1 M R R R R R R R
2 M R T T T T T T
3 M R T S S S S S
4 M R T S Y Y Y Y
5 M R T S Y N N N
6 M R T S Y N Q Q
7 M R T S Y N Q W
8 M R T S S S S S

 

[JW]

One Way. This will identify the last used row and last used column in
your spreadsheet and cycle through til complete. If you want it to
cycle through different columns/rows, just change the values assigned
to the variables as needed.
Sub likeThis()
Dim sRow As Long, lRow As Long
Dim sCol As Integer, lCol As Integer
Dim found As Boolean
sRow = 1
sCol = 1
lRow = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
lCol = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
For i = sRow To lRow
found = False
For j = sCol To lCol
If found = False Then
If IsEmpty(Cells(i, j)) Then
Cells(i, j).Delete Shift:=xlToLeft
j = j - 1
Else
found = True
End If
Else
If IsEmpty(Cells(i, j)) Then _
Cells(i, j) = Cells(i, j).Offset(0, -1)
End If
Next j
Next i
End Sub

 

[Guest]

I am sorry but, that macro didn't work at all. It pulled information from
incorrect cells and didn't match the diagram I provided.

Thanks though

One Way. This will identify the last used row and last used column in
your spreadsheet and cycle through til complete. If you want it to
cycle through different columns/rows, just change the values assigned
to the variables as needed.
Sub likeThis()
Dim sRow As Long, lRow As Long
Dim sCol As Integer, lCol As Integer
Dim found As Boolean
sRow = 1
sCol = 1
lRow = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
lCol = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
For i = sRow To lRow
found = False
For j = sCol To lCol
If found = False Then
If IsEmpty(Cells(i, j)) Then
Cells(i, j).Delete Shift:=xlToLeft
j = j - 1
Else
found = True
End If
Else
If IsEmpty(Cells(i, j)) Then _
Cells(i, j) = Cells(i, j).Offset(0, -1)
End If
Next j
Next i
End Sub

I have the following Excel table:

x = blank cells

A B C D E F G H
1 x x x x x x M R
2 x x x x x M R T
3 x x x x M R T S
4 x x x M R T S Y
5 x x M R T S Y N
6 x M R T S Y N Q
7 M R T S Y N Q W
8 x x x x M R T S

I want to have Excel see the blanks (if there is one) and place the M in
column A and any cells up to column H to be back filled with the existing
data. Please see what I want the above table to look like after macro:

A B C D E F G H
1 M R R R R R R R
2 M R T T T T T T
3 M R T S S S S S
4 M R T S Y Y Y Y
5 M R T S Y N N N
6 M R T S Y N Q Q
7 M R T S Y N Q W
8 M R T S S S S S

 

[JW]

I am sorry but, that macro didn't work at all. It pulled information from
incorrect cells and didn't match the diagram I provided.

Thanks though

One Way. This will identify the last used row and last used column in
your spreadsheet and cycle through til complete. If you want it to
cycle through different columns/rows, just change the values assigned
to the variables as needed.
Sub likeThis()
Dim sRow As Long, lRow As Long
Dim sCol As Integer, lCol As Integer
Dim found As Boolean
sRow = 1
sCol = 1
lRow = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
lCol = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
For i = sRow To lRow
found = False
For j = sCol To lCol
If found = False Then
If IsEmpty(Cells(i, j)) Then
Cells(i, j).Delete Shift:=xlToLeft
j = j - 1
Else
found = True
End If
Else
If IsEmpty(Cells(i, j)) Then _
Cells(i, j) = Cells(i, j).Offset(0, -1)
End If
Next j
Next i
End Sub

Worked 100% perfect for me and produced the exact diagram you
provided. What version of Excel are you running? Send me your
spreadsheet to the e-mail in my profile.

 

[Guest]

Email sent. I am using 2007

I am sorry but, that macro didn't work at all. It pulled information from
incorrect cells and didn't match the diagram I provided.

Thanks though

One Way. This will identify the last used row and last used column in
your spreadsheet and cycle through til complete. If you want it to
cycle through different columns/rows, just change the values assigned
to the variables as needed.
Sub likeThis()
Dim sRow As Long, lRow As Long
Dim sCol As Integer, lCol As Integer
Dim found As Boolean
sRow = 1
sCol = 1
lRow = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
lCol = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
For i = sRow To lRow
found = False
For j = sCol To lCol
If found = False Then
If IsEmpty(Cells(i, j)) Then
Cells(i, j).Delete Shift:=xlToLeft
j = j - 1
Else
found = True
End If
Else
If IsEmpty(Cells(i, j)) Then _
Cells(i, j) = Cells(i, j).Offset(0, -1)
End If
Next j
Next i
End Sub

Jason Hall wrote:
I have the following Excel table:

x = blank cells

A B C D E F G H
1 x x x x x x M R
2 x x x x x M R T
3 x x x x M R T S
4 x x x M R T S Y
5 x x M R T S Y N
6 x M R T S Y N Q
7 M R T S Y N Q W
8 x x x x M R T S

I want to have Excel see the blanks (if there is one) and place the M in
column A and any cells up to column H to be back filled with the existing
data. Please see what I want the above table to look like after macro:

A B C D E F G H
1 M R R R R R R R
2 M R T T T T T T
3 M R T S S S S S
4 M R T S Y Y Y Y
5 M R T S Y N N N
6 M R T S Y N Q Q
7 M R T S Y N Q W
8 M R T S S S S S

Worked 100% perfect for me and produced the exact diagram you
provided. What version of Excel are you running? Send me your
spreadsheet to the e-mail in my profile.

 

[Chip Pearson]

Try the following code. It assumes that your range is named "TheGrid".

Sub FillGrid()

Dim FirstCell As Range
Dim EndCell As Range

Dim FirstCol As Long
Dim LastCol As Long

Dim FirstRow As Long
Dim LastRow As Long

Dim RowNdx As Long
Dim ColNdx As Long

Dim DestCell As Range
Dim FillValue As Variant
Dim CopyRng As Range
Dim FillStart As Long
Dim FillLen As Long

With Range("TheGrid")
FirstRow = .Cells(1, 1).Row
LastRow = .Cells(.Cells.Count).Row
FirstCol = .Cells(1, 1).Column
LastCol = .Cells(.Cells.Count).Column
End With
For RowNdx = FirstRow To LastRow
ColNdx = FirstCol
If Cells(RowNdx, FirstCol).Value = vbNullString Then
Do Until (Cells(RowNdx, ColNdx) <> vbNullString) Or (ColNdx =
LastCol)
ColNdx = ColNdx + 1
Loop
Set FirstCell = Cells(RowNdx, ColNdx)

If FirstCell.Value <> vbNullString Then
Set DestCell = Cells(RowNdx, FirstCol)
Cells(RowNdx, FirstCell.Column).Resize(1, LastCol -
FirstCell.Column + 1).Copy Destination:=DestCell
FillValue = Cells(RowNdx, LastCol)
FillStart = FirstCol + (LastCol - FirstCell.Column)
FillLen = LastCol - FillStart + 1
Cells(RowNdx, FillStart).Resize(1, FillLen).FillRight

End If
End If
Next RowNdx

End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[Guest]

Thanks!!

Try the following code. It assumes that your range is named "TheGrid".

Sub FillGrid()

Dim FirstCell As Range
Dim EndCell As Range

Dim FirstCol As Long
Dim LastCol As Long

Dim FirstRow As Long
Dim LastRow As Long

Dim RowNdx As Long
Dim ColNdx As Long

Dim DestCell As Range
Dim FillValue As Variant
Dim CopyRng As Range
Dim FillStart As Long
Dim FillLen As Long

With Range("TheGrid")
FirstRow = .Cells(1, 1).Row
LastRow = .Cells(.Cells.Count).Row
FirstCol = .Cells(1, 1).Column
LastCol = .Cells(.Cells.Count).Column
End With
For RowNdx = FirstRow To LastRow
ColNdx = FirstCol
If Cells(RowNdx, FirstCol).Value = vbNullString Then
Do Until (Cells(RowNdx, ColNdx) <> vbNullString) Or (ColNdx =
LastCol)
ColNdx = ColNdx + 1
Loop
Set FirstCell = Cells(RowNdx, ColNdx)

If FirstCell.Value <> vbNullString Then
Set DestCell = Cells(RowNdx, FirstCol)
Cells(RowNdx, FirstCell.Column).Resize(1, LastCol -
FirstCell.Column + 1).Copy Destination:=DestCell
FillValue = Cells(RowNdx, LastCol)
FillStart = FirstCol + (LastCol - FirstCell.Column)
FillLen = LastCol - FillStart + 1
Cells(RowNdx, FillStart).Resize(1, FillLen).FillRight

End If
End If
Next RowNdx

End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[JW]

Thanks!!

Looks like Chip got you covered. But thought I would post this up
anyhow. Based on the sheet you sent me, the cells may look empty, but
they aren't. So, I just changed the IsEmpty check to a Len check and
it works fine. Keep in mind that this is in Excel 2003, though it
should work fine in 2007.
Sub likeThis()
Dim sRow As Long, lRow As Long
Dim sCol As Integer, lCol As Integer
Dim found As Boolean
sRow = 2
sCol = 1
lRow = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
lCol = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
For i = sRow To lRow
found = False
For j = sCol To lCol
If found = False Then
If Len(Cells(i, j)) = 0 Then
Cells(i, j).Delete Shift:=xlToLeft
j = j - 1
Else
found = True
End If
Else
If Len(Cells(i, j)) = 0 Then _
Cells(i, j) = Cells(i, j).Offset(0, -1)
End If
Next j
Next i
End Sub

 

[Dana DeLouis]

If the cells to the right of your table is clear, maybe:

Sub Demo()
With [A1:H8]
.SpecialCells(xlCellTypeBlanks).Delete (xlToLeft)
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
.Value = .Value
End With
End Sub

 

[Chip Pearson]

Now that's slick. I wish I had thought of that.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

If the cells to the right of your table is clear, maybe:

Sub Demo()
With [A1:H8]
.SpecialCells(xlCellTypeBlanks).Delete (xlToLeft)
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
.Value = .Value
End With
End Sub

--
Dana DeLouis
Windows XP & Excel 2007

I have the following Excel table:

x = blank cells

A B C D E F G H
1 x x x x x x M R
2 x x x x x M R T
3 x x x x M R T S
4 x x x M R T S Y
5 x x M R T S Y N
6 x M R T S Y N Q
7 M R T S Y N Q W
8 x x x x M R T S

I want to have Excel see the blanks (if there is one) and place the M in
column A and any cells up to column H to be back filled with the existing
data. Please see what I want the above table to look like after macro:

A B C D E F G H
1 M R R R R R R R
2 M R T T T T T T
3 M R T S S S S S
4 M R T S Y Y Y Y
5 M R T S Y N N N
6 M R T S Y N Q Q
7 M R T S Y N Q W
8 M R T S S S S S

 

[JW]

Chip, I agree. That is some really slick code Dana.

Now that's slick. I wish I had thought of that.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

If the cells to the right of your table is clear, maybe:

Sub Demo()
With [A1:H8]
.SpecialCells(xlCellTypeBlanks).Delete (xlToLeft)
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
.Value = .Value
End With
End Sub

--
Dana DeLouis
Windows XP & Excel 2007

I have the following Excel table:

x = blank cells

A B C D E F G H
1 x x x x x x M R
2 x x x x x M R T
3 x x x x M R T S
4 x x x M R T S Y
5 x x M R T S Y N
6 x M R T S Y N Q
7 M R T S Y N Q W
8 x x x x M R T S

I want to have Excel see the blanks (if there is one) and place the M in
column A and any cells up to column H to be back filled with the existing
data. Please see what I want the above table to look like after macro:

A B C D E F G H
1 M R R R R R R R
2 M R T T T T T T
3 M R T S S S S S
4 M R T S Y Y Y Y
5 M R T S Y N N N
6 M R T S Y N Q Q
7 M R T S Y N Q W
8 M R T S S S S S