Well, thanks to a huge push from Tom Ogilvy, I finally got this darned thing
resolved.
For the benefit of others who encounter a similar challenge follow these
(simple) instructions:
Data (in my case names) is listed in Column A. Column B contains the
following function:
=COUNT(SEARCH($A2,'Import Sheet'!$A$1:$A$65000))
C+S+E
Column C contains the following function (or versions of the function, based
on the macro below):
=IF(ROWS(C$2:C2)<=B$1,"A"&SMALL(IF(ISNUMBER(SEARCH(A2,'Import
Sheet'!A$1:A$65000)),ROW('Import Sheet'!A$1:A$65000)),ROWS(C$2:C2)),"")
C+S+E
Finally, Column D contains this function:
=INDIRECT("'Import Sheet'!"&C2)
Not C+S+E
Cell B1 contains this function:
=COUNT(B2:B65536)
Cell T1 contains this function:
=LOOKUP(10^10,B2:B500)-1
The entire macro looks like this:
Sub InsertVarRows()
Dim myRow As Long
Dim rng As Range
Dim sngStart As Double
sngStart = Now
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
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"
Dim iStart As Long
Dim sFormula As String
Dim iLastRow As Long
Dim j As Long
With ActiveSheet
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
sFormula = "=IF(ROWS(R<row>C:RC)<=R1C[-1],""A""&" & _
"SMALL(IF(ISNUMBER(SEARCH(RC[-2]," & _
"'Import Sheet'!R1C[-2]:R65000C[-2]))," & _
"ROW('Import Sheet'!R1C[-2]:R65000C[-2]))," & _
"ROWS(R<row>C:RC)),"""")"
iStart = 2
For j = 2 To iLastRow
If Cells(j, 2) = Cells(j - 1, 2) Then
.Cells(j, "C").FormulaArray = Replace(sFormula, "<row>", j - 1)
.Cells(j, "C").FillDown
Else
.Cells(j, "C").FormulaArray = Replace(sFormula, "<row>", j)
End If
Next
End With
‘The part that I had trouble with is:
‘From: Dim iStart As Long
‘To: End With
‘This thing was a pain-in-the-butt!!!
Range("D2").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'Import Sheet'!""&RC[-1])"
Dim LastRow3 As Long 'Fills down, based on data in column to left
With ActiveSheet
LastRow3 = .Cells(.Rows.Count, "C").End(xlUp).Row
.Range("D2").AutoFill Destination:=.Range("D2
" & LastRow3)
End With
MsgBox "Process Complete!! " & Counter & _
" File Updated!" & vbNewLine & _
" took " & Format(Now - sngStart, "hh:mm:ss")
End Sub
Thanks to all who helped out!!!
Thanks 1,000,000*!
Ryan--
RyGuy said:
Thanks for the help OssieMac. I think this is a bit more related to
programming than it is related to functions. I think I will try a similar
post in the programming DG. In the meantime, I will continue to work out a
solution by myself. If I can get something workable, I will post back here
for closure.
Regards,
Ryan--
OssieMac said:
Hi Ryan,
I'm sorry but I don't have the answers to this. Perhaps someone else can help.
Regards,
OssieMac
RyGuy said:
I made a little progress b/w last night and today. I believe the problem is
that I need to refer to a cell, such as this:
KeyCell = ActiveCell.Address(False, True)
I found the code on this DG. I guess this makes the Row absolute and the
Column relative. This is great, now I need to add this to part of my code:
In the second part of the loop, if the values in Column A evaluate to <>
prior cell, I would like to replace this:
ROWS(R2C[-1]:RC[-1])
With this:
KeyCell = ActiveCell.Address(False, True)
Key Cell = ROWS(R2C[-1]:RC[-1) < -- somehow the rows have to be an absolute
reference, until there is a change in Column A
The entire loop is shown below:
Do Until ActiveCell.Offset(0, -1) = Empty
If ActiveCell.Offset(0, -1) = ActiveCell.Offset(-1, 1) Then 'And ActiveCell
<> Empty And ActiveCell.Offset(1) <> Empty Then
Selection.FormulaArray = _
"=IF(ROWS(R2C[-1]:RC[-1])<=R1C[-1],""A""&SMALL(IF(ISNUMBER(SEARCH(RC[-2],'Import
Sheet'!R1C[-2]:R65000C[-2])),ROW('Import
Sheet'!R1C[-2]:R65000C[-2])),ROWS(R2C[-1]:RC[-1])),"""")"
ActiveCell.Offset(1, 0).Select
End If
If ActiveCell.Offset(0, -1) <> ActiveCell.Offset(-1, 1) Then
Selection.FormulaArray = _
"=IF(ROWS(R10C[-1]:RC[-1])<=R1C[-1],""A""&SMALL(IF(ISNUMBER(SEARCH(RC[-2],'Import
Sheet'!R1C[-2]:R65000C[-2])),ROW('Import
Sheet'!R1C[-2]:R65000C[-2])),ROWS(R10C[-1]:RC[-1])),"""")"
ActiveCell.Offset(1, 0).Select
End If
Loop
The ultimate objective is to get Excel to give me an absolute reference in
Cell C2 (B2 is being referenced), such as (ROWS(B$2:B2), (ROWS(B$2:B3),
(ROWS(B$2:B4), down to the change in value in Column A, which could be
anywhere, but in my current scenario, it is in A10. When I get to A10, I
would like Excel to change the reference to (ROWS(B$10:B10). Then there is a
change at A11, so I would like Excel to reference (ROWS(B$11:B11),
(ROWS(B$11:B12), etc…down to the next change. Does this make sense? Is it
possible?
Thanks,
Ryan--
:
The code looks like this:
Do Until ActiveCell.Offset(0, -1) = Empty
If ActiveCell.Offset(0, -1) = ActiveCell.Offset(-1, 1) Then 'And ActiveCell
<> Empty And ActiveCell.Offset(1) <> Empty Then
Selection.FormulaArray = _
"=IF(ROWS(R2C[-1]:RC[-1])<=R1C[-1],""A""&SMALL(IF(ISNUMBER(SEARCH(RC[-2],'Import
Sheet'!R1C[-2]:R65000C[-2])),ROW('Import
Sheet'!R1C[-2]:R65000C[-2])),ROWS(R2C[-1]:RC[-1])),"""")"
ActiveCell.Offset(1, 0).Select
End If
If ActiveCell.Offset(0, -1) <> ActiveCell.Offset(-1, 1) Then
Selection.FormulaArray = _
"=IF(ROWS(R10C[-1]:RC[-1])<=R1C[-1],""A""&SMALL(IF(ISNUMBER(SEARCH(RC[-2],'Import
Sheet'!R1C[-2]:R65000C[-2])),ROW('Import
Sheet'!R1C[-2]:R65000C[-2])),ROWS(R10C[-1]:RC[-1])),"""")"
ActiveCell.Offset(1, 0).Select
End If
Loop
I was trying to get the part:
R10C of
ROWS(R10C[-1]:RC[-1])
to be absolute if there is a change in values in Column A (which is
evaluated by the following)
If ActiveCell.Offset(0, -1) <> ActiveCell.Offset(-1, 1)
I can't think of a way to get the R10C to be absolute and then change once
the values in Column A change.
Has anyone dealt with this before. I can't help but think that I am making
it wayyyy more difficult that it should be. If anyone has any ideas, please
share.
Regards,
Ryan---
--
RyGuy
:
Hi Ryan,
I can't say that I really understand your question. However, here are some
samples of code which might help. If it doesn't, then can you please post a
sample of your data and explain:-
1. What cells you are trying to compare.
2. What you want to do if compare is equal.
3. What you want to do if compare is not equal.
Dim rngCell As Range
Range("B1").Select 'Becomes the ActiveCell
'Assign cell to a range variable (Don't forget the 'Set' )
Set rngCell = ActiveCell.Offset(0, -1) 'Range("A1")
rngCell.Select 'Select cell by range variable
'Compare by using the range variable in lieu of the cell reference
If rngCell = ActiveCell.Offset(-1, 1) Then
'do stuff because it is equal
Else
'Reassign a new cell to rngCell variable
Set rngCell = ActiveCell.Offset(-1, 1)
End If
Regards,
OssieMac
