Hierarchy Macro

J

Jason Hall

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
 
J

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
 
J

Jason Hall

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

JW said:
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 said:
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
Click to expand...
Click to expand...
 
J

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

JW said:
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
Click to expand...
Click to expand...

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.
 
J

Jason Hall

Email sent. I am using 2007

JW said:
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

JW said:
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
Click to expand...
Jason Hall wrote:
I have the following Excel table:
Click to expand...
x = blank cells
Click to expand...
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
Click to expand...
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:
Click to expand...
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
Click to expand...
Click to expand...

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.
Click to expand...
 
C

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)
 
J

Jason Hall

Thanks!!

Chip Pearson said:
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)
Click to expand...
 
J

JW

Thanks!!
Click to expand...

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
 
D

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
 
C

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)

Dana DeLouis said:
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


Jason Hall said:
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
Click to expand...
Click to expand...
 
J

JW

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

Chip said:
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)

Dana DeLouis said:
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


Jason Hall said:
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
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Incrementing IPv6 address 1
Fill array with Values 4
Word Error Message: This file is corrupt and cannot be opened 1
OJG;mlorAM 0
Group 1
Randomize from set of values 9
Macro to delete row if cells greater than certain value 1
Merging worksheets 0

Top