Carpiem
08-10-2006, 11:28 AM
Hello All,
Hoping someone can fix my macros that use ?Find? to locate all rows (In Column A) with the word ?Total? and then copy the active cell and paste it to the next cell in that row.
With the attached file this would translate as the ?Yellow? highlighted cells (G4, G7 and G12).
The following 2 macros in use don?t quite work. Row 12 cell ?F12? is copied to ?G12? and but nothing happens in rows 4 & 7.
Sub Totals()
FindThis
Cells(ActiveCell.Row, ActiveCell.Column + 5).Copy
With Selection
Cells(ActiveCell.Row, ActiveCell.Column).Offset(0, 6).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End With
[A2].Select
End Sub
Private Sub FindThis()
Dim Cell As Range, FirstAddress As String
With Range("Column")
Set Cell = .Find("Total", LookIn:=xlValues, searchorder:=xlByRows, _
LookAt:=xlPart, MatchCase:=True)
'Error handling if no "Total" found
On Error GoTo Finish
'Start Point of Search
FirstAddress = Cell.Address
Do
Cell.Select
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
End With
Finish:
End Sub
Any help is much appreciated? Thank you in advance.
Carpiem
Hoping someone can fix my macros that use ?Find? to locate all rows (In Column A) with the word ?Total? and then copy the active cell and paste it to the next cell in that row.
With the attached file this would translate as the ?Yellow? highlighted cells (G4, G7 and G12).
The following 2 macros in use don?t quite work. Row 12 cell ?F12? is copied to ?G12? and but nothing happens in rows 4 & 7.
Sub Totals()
FindThis
Cells(ActiveCell.Row, ActiveCell.Column + 5).Copy
With Selection
Cells(ActiveCell.Row, ActiveCell.Column).Offset(0, 6).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End With
[A2].Select
End Sub
Private Sub FindThis()
Dim Cell As Range, FirstAddress As String
With Range("Column")
Set Cell = .Find("Total", LookIn:=xlValues, searchorder:=xlByRows, _
LookAt:=xlPart, MatchCase:=True)
'Error handling if no "Total" found
On Error GoTo Finish
'Start Point of Search
FirstAddress = Cell.Address
Do
Cell.Select
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
End With
Finish:
End Sub
Any help is much appreciated? Thank you in advance.
Carpiem