Last Value in Column B Shifted Down & Value in Column A Shifted Do

[Guest]

I am trying to figure out a way to find the total number of items in a list,
in my case it is in Column B, insert a row in Column A, for each item in
Column B, and fill in all the spaces in column A and Column B. Most of my
code (some other stuff is irrelevant) is listed below:


Range("A1").Select
lastcell = Cells(Rows.Count, "A").End(xlUp).Row
myRow = 2
Do Until myRow = lastcell
For I = 2 To Cells(myRow, 2) 'start counter at 2
If Cells(myRow, 1) <> "" Then
Cells(myRow + 1, 1).Select
Selection.EntireRow.Insert shift:=xlDown
End If
Next
lastcell = Cells(Rows.Count, "A").End(xlUp).Row
myRow = myRow + 1
Loop

Last = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
Range("A2:A" & Last).SpecialCells(xlCellTypeBlanks).FormulaR1C1 =
"=R[-1]C"


Range("B2").Select
Selection.FormulaArray = _
"=IF(RC[-1]<>"""",COUNT(SEARCH(RC1,'Import Sheet'!R1C1:R65000C1)),"""")"
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B2").AutoFill Destination:=.Range("B2:B" & LastRow)
End With

What I can’t get working is the incrementing of items in the last row in
Column A and the last row in Column B, both of which are dynamic. If Cell
B20 contains a value of 8, I would like to see the corresponding value in
Column A shift down (and blanks subsequently filled in) by 8 and Column B
shift down (and blanks subsequently filled in). Does anyone have any ideas
about this? I am almost done with this project. I told my supervisor I’d do
it because I though it was quite interesting, but not it is turning to be a
pain in the butt. Well, it is still very interesting; I just want to get
this last piece of the puzzle in place. I would sincerely appreciate any
assistance.

Cordially,
Ryan---

 

[Guest]

Well, I solved my own problem. It is not pretty, but I got this working:

Sub ToughOne()
Dim myRow As Long
Dim rng As Range

Range("B2").Select
Selection.FormulaArray = _
"=IF(RC[-1]<>"""",COUNT(SEARCH(RC1,'Import Sheet'!R1C1:R65000C1)),"""")"
Dim LastRow As Long 'Fills down, based on data in column to left
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B2").AutoFill Destination:=.Range("B2:B" & LastRow)
End With

Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Range("A1").Select
lastcell = Cells(Rows.Count, "A").End(xlUp).Row
myRow = 2
Do Until myRow = lastcell
For I = 2 To Cells(myRow, 2) 'start counter at 2
If Cells(myRow, 1) <> "" Then
Cells(myRow + 1, 1).Select
'Selection.Insert shift:=xlDown
Selection.EntireRow.Insert shift:=xlDown
End If
Next
lastcell = Cells(Rows.Count, "A").End(xlUp).Row
myRow = myRow + 1
Loop

Range("B2").Select
Selection.FormulaArray = _
"=IF(RC[-1]<>"""",COUNT(SEARCH(RC1,'Import Sheet'!R1C1:R65000C1)),"""")"
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B2").AutoFill Destination:=.Range("B2:B" & LastRow)
End With

'Right here is where I had trouble...***********
Dim LastRow1 As Long
LastRow1 = Range("T1")
Range("B500").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.Offset(LastRow1, 0)).Select
Selection.FormulaR1C1 = "=R[-1]C"
'*************************************

Last = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
Range("A2:A" & Last).SpecialCells(xlCellTypeBlanks).FormulaR1C1 =
"=R[-1]C"

End Sub

And finally, a function in T1:
=LOOKUP(10^10,B2:B492)-2

It is not eloquent, but it works. Thanks to all who looked at this and
tried to help. Hopefully this solution will, one day, help someone else...
Ryan---

--
RyGuy

I am trying to figure out a way to find the total number of items in a list,
in my case it is in Column B, insert a row in Column A, for each item in
Column B, and fill in all the spaces in column A and Column B. Most of my
code (some other stuff is irrelevant) is listed below:


Range("A1").Select
lastcell = Cells(Rows.Count, "A").End(xlUp).Row
myRow = 2
Do Until myRow = lastcell
For I = 2 To Cells(myRow, 2) 'start counter at 2
If Cells(myRow, 1) <> "" Then
Cells(myRow + 1, 1).Select
Selection.EntireRow.Insert shift:=xlDown
End If
Next
lastcell = Cells(Rows.Count, "A").End(xlUp).Row
myRow = myRow + 1
Loop

Last = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
Range("A2:A" & Last).SpecialCells(xlCellTypeBlanks).FormulaR1C1 =
"=R[-1]C"


Range("B2").Select
Selection.FormulaArray = _
"=IF(RC[-1]<>"""",COUNT(SEARCH(RC1,'Import Sheet'!R1C1:R65000C1)),"""")"
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B2").AutoFill Destination:=.Range("B2:B" & LastRow)
End With

What I can’t get working is the incrementing of items in the last row in
Column A and the last row in Column B, both of which are dynamic. If Cell
B20 contains a value of 8, I would like to see the corresponding value in
Column A shift down (and blanks subsequently filled in) by 8 and Column B
shift down (and blanks subsequently filled in). Does anyone have any ideas
about this? I am almost done with this project. I told my supervisor I’d do
it because I though it was quite interesting, but not it is turning to be a
pain in the butt. Well, it is still very interesting; I just want to get
this last piece of the puzzle in place. I would sincerely appreciate any
assistance.

Cordially,
Ryan---