PDA

View Full Version : How to change the code to search by row instead of by column?



clif
06-30-2012, 06:50 AM
How to change the code to search by row instead of by column?

With Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
'http://www.cpearson.com/excel/FindAll.aspx
Set LastCell = .Cells(.Cells.Count)
Set FoundCell = .Find(What:="X", After:=LastCell)
If Not FoundCell Is Nothing Then
FirstAddr = FoundCell.Address
End If
Do Until FoundCell Is Nothing
FoundCell.Offset(0, -1).Select
Selection.copy

Range("I1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False



Set FoundCell = .FindNext(After:=FoundCell)
If FoundCell.Address = FirstAddr Then
Exit Do
End If
Loop
End With
:banghead:

Kenneth Hobs
06-30-2012, 10:53 AM
xlByColumns

See if this gives you any ideas.

http://www.vbaexpress.com/forum/showthread.php?t=38802
Sub Test_FoundRanges()
Dim findRange As Range, findString As String, foundRange As Range
Dim r As Range, i As Long

On Error GoTo EndNow:
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

Set findRange = ActiveSheet.Range("A1:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row)
findString = "Allocation"
Set foundRange = FoundRanges(findRange, findString)
If foundRange Is Nothing Then GoTo EndNow

'If Not foundRange Is Nothing Then MsgBox foundRange.Address 'Note that range is in reverse order
If Not foundRange Is Nothing Then foundRange.EntireRow.Delete
'For i = i to foundRange.Areas.Count
' foundRange.Areas(i).EntireRow.Delete
'Next i

EndNow:
SpeedOff
End Sub


Function FoundRanges(fRange As Range, fStr As String) As Range
Dim objFind As Range
Dim rFound As Range, FirstAddress As String

With fRange
Set objFind = .Find(what:=fStr, After:=fRange.Cells(fRange.Rows.Count, fRange.Columns.Count), _
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
If Not objFind Is Nothing Then
Set rFound = objFind
FirstAddress = objFind.Address
Do
Set objFind = .FindNext(objFind)
If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
End If
End With
Set FoundRanges = rFound
End Function