I would be so thrilled to finish this project before COB today. Ive been
trying, for about two weeks, to find a solution to a problem of identifying
cell addresses and then comparing the cell to the left (offset(-1,0)) with
the cell to the left and up one (offset(-1,-1)). If these cells contain the
same values, Id like to move down one cell (in the current column) and do a
simple xlFillDefault. If the cell to the left, and to the left and up one,
are different, Id like to do a search for the value in column A, and return
the cell address that matches this value on another sheet.


This is where I am now:

Sub Final2()
Dim iStart As Long
Dim sFormula As String
Dim iLastRow As Long
Dim i As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
sFormula = "=IF(ROWS(R<rowC: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<rowC:RC)),"""")"

iStart = 2
For i = 3 To iLastRow + 1
If ActiveCell.Offset(-1, 0).Value < ActiveCell.Offset(-1, -1).Value Then
..Cells(i - 1, "C").FormulaArray = Replace(sFormula, "<row", iStart)
iStart = i
End If

If ActiveCell.Offset(-1, 0).Value = ActiveCell.Offset(-1, -1).Value Then
Set fillrange = Range(ActiveCell, ActiveCell.Offset(1, 0))
fillrange.AutoFill Destination:=Range("C2:C" & cell.Row + 1),
Type:=xlFillDefault
iStart = i
End If

Next i
End With
End Sub

The macro fails at this line:
fillrange.AutoFill Destination:=Range("C2:C" & cell.Row + 1),
Type:=xlFillDefault


The second If never seems to get evaluated, and it should because the cells
on the left are not always equal. If I change the first If to:
If ActiveCell.Offset(-1, 0).Value = ActiveCell.Offset(-1, -1).Value Then
€¦and the second IF to:
If ActiveCell.Offset(-1, 0).Value < ActiveCell.Offset(-1, -1).Value Then

€¦then the code fails at this line:
fillrange.AutoFill Destination:=Range("C2:C" & cell.Row + 1),
Type:=xlFillDefault


Again, this is supposed to do a comparison b/w two values in Column B, then,
in the same row as the current row and the row above, the macro should take
the value in
Column C, and fill down one row if there is a match b/w the two values in
Column B. If there is no match, then it should loop back to the first part of
the For-Next loop, which enters the array-type function into the current cell
in Column C.

Ive received great help from Bob, Joel, OssieMac, Max, Peo, and especially
T. Valko (thank you so much). Now, I've hit a wall; I am not sure what to do
now. Does anyone have any ideas about this? I think Im about 95% of the
way there; I just need a push to get that last 5%.


Cordially,
Ryan--

RyGuy has reposted in .programming.

RyGuy wrote:

I would be so thrilled to finish this project before COB today. Ive been
trying, for about two weeks, to find a solution to a problem of identifying
cell addresses and then comparing the cell to the left (offset(-1,0)) with
the cell to the left and up one (offset(-1,-1)). If these cells contain the
same values, Id like to move down one cell (in the current column) and do a
simple xlFillDefault. If the cell to the left, and to the left and up one,
are different, Id like to do a search for the value in column A, and return
the cell address that matches this value on another sheet.

This is where I am now:

Sub Final2()
Dim iStart As Long
Dim sFormula As String
Dim iLastRow As Long
Dim i As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
sFormula = "=IF(ROWS(R<rowC: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<rowC:RC)),"""")"

iStart = 2
For i = 3 To iLastRow + 1
If ActiveCell.Offset(-1, 0).Value < ActiveCell.Offset(-1, -1).Value Then
.Cells(i - 1, "C").FormulaArray = Replace(sFormula, "<row", iStart)
iStart = i
End If

If ActiveCell.Offset(-1, 0).Value = ActiveCell.Offset(-1, -1).Value Then
Set fillrange = Range(ActiveCell, ActiveCell.Offset(1, 0))
fillrange.AutoFill Destination:=Range("C2:C" & cell.Row + 1),
Type:=xlFillDefault
iStart = i
End If

Next i
End With
End Sub

The macro fails at this line:
fillrange.AutoFill Destination:=Range("C2:C" & cell.Row + 1),
Type:=xlFillDefault

The second If never seems to get evaluated, and it should because the cells
on the left are not always equal. If I change the first If to:
If ActiveCell.Offset(-1, 0).Value = ActiveCell.Offset(-1, -1).Value Then
€¦and the second IF to:
If ActiveCell.Offset(-1, 0).Value < ActiveCell.Offset(-1, -1).Value Then

€¦then the code fails at this line:
fillrange.AutoFill Destination:=Range("C2:C" & cell.Row + 1),
Type:=xlFillDefault

Again, this is supposed to do a comparison b/w two values in Column B, then,
in the same row as the current row and the row above, the macro should take
the value in
Column C, and fill down one row if there is a match b/w the two values in
Column B. If there is no match, then it should loop back to the first part of
the For-Next loop, which enters the array-type function into the current cell
in Column C.

Ive received great help from Bob, Joel, OssieMac, Max, Peo, and especially
T. Valko (thank you so much). Now, I've hit a wall; I am not sure what to do
now. Does anyone have any ideas about this? I think Im about 95% of the
way there; I just need a push to get that last 5%.

Cordially,
Ryan--

--

Dave Peterson

....same answer (below) is posted in Excel-Programming

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<rowC: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<rowC: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:D" & 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--


"Dave Peterson" wrote:

RyGuy has reposted in .programming.

RyGuy wrote:

I would be so thrilled to finish this project before COB today. I€„¢ve been
trying, for about two weeks, to find a solution to a problem of identifying
cell addresses and then comparing the cell to the left (offset(-1,0)) with
the cell to the left and up one (offset(-1,-1)). If these cells contain the
same values, I€„¢d like to move down one cell (in the current column) and do a
simple xlFillDefault. If the cell to the left, and to the left and up one,
are different, I€„¢d like to do a search for the value in column A, and return
the cell address that matches this value on another sheet.

This is where I am now:

Sub Final2()
Dim iStart As Long
Dim sFormula As String
Dim iLastRow As Long
Dim i As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
sFormula = "=IF(ROWS(R<rowC: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<rowC:RC)),"""")"

iStart = 2
For i = 3 To iLastRow + 1
If ActiveCell.Offset(-1, 0).Value < ActiveCell.Offset(-1, -1).Value Then
.Cells(i - 1, "C").FormulaArray = Replace(sFormula, "<row", iStart)
iStart = i
End If

If ActiveCell.Offset(-1, 0).Value = ActiveCell.Offset(-1, -1).Value Then
Set fillrange = Range(ActiveCell, ActiveCell.Offset(1, 0))
fillrange.AutoFill Destination:=Range("C2:C" & cell.Row + 1),
Type:=xlFillDefault
iStart = i
End If

Next i
End With
End Sub

The macro fails at this line:
fillrange.AutoFill Destination:=Range("C2:C" & cell.Row + 1),
Type:=xlFillDefault

The second If never seems to get evaluated, and it should because the cells
on the left are not always equal. If I change the first If to:
If ActiveCell.Offset(-1, 0).Value = ActiveCell.Offset(-1, -1).Value Then
€¦and the second IF to:
If ActiveCell.Offset(-1, 0).Value < ActiveCell.Offset(-1, -1).Value Then

€¦then the code fails at this line:
fillrange.AutoFill Destination:=Range("C2:C" & cell.Row + 1),
Type:=xlFillDefault

Again, this is supposed to do a comparison b/w two values in Column B, then,
in the same row as the current row and the row above, the macro should take
the value in
Column C, and fill down one row if there is a match b/w the two values in
Column B. If there is no match, then it should loop back to the first part of
the For-Next loop, which enters the array-type function into the current cell
in Column C.

I€„¢ve received great help from Bob, Joel, OssieMac, Max, Peo, and especially
T. Valko (thank you so much). Now, I've hit a wall; I am not sure what to do
now. Does anyone have any ideas about this? I think I€„¢m about 95% of the
way there; I just need a push to get that last 5%.

Cordially,
Ryan--

--

Dave Peterson