Need with with macro/visual basic

[TCollin6]

I am attempting to build a macro that finds content of a certain font and color (already figures that one out) and then cut that cell, move one cell to the left and one cell down and paste. I am wanting to be able to complete this function around 4000 times. Any ideas? I have only started toying with VB, so I'm not that wise yet.

Any assistance you may be able to provide would be greatly appreciated!

Tim

 

[Norie]

Can you post the code you already have and also explain further exactly what you want?

I'm sure it can be adapted to work multiple times.

 

[TCollin6]

Here's what I got so far.....

Sub moveme()
'
' moveme Macro
' Macro recorded 1/25/2005 by TCollin6
'

'
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
Range("C1618").Select
Cells.FindNext(After:=ActiveCell).Activate
Range("C1619").Select
Application.FindFormat.Clear
Application.FindFormat.NumberFormat = "General"
With Application.FindFormat
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
With Application.FindFormat.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 9.75
.Strikethrough = False
.Superscript = False
.Subscript = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 10
End With
Application.FindFormat.Borders(xlLeft).LineStyle = xlNone
Application.FindFormat.Borders(xlRight).LineStyle = xlNone
Application.FindFormat.Borders(xlTop).LineStyle = xlNone
Application.FindFormat.Borders(xlBottom).LineStyle = xlNone
Application.FindFormat.Borders(xlDiagonalDown).LineStyle = xlNone
Application.FindFormat.Borders(xlDiagonalUp).LineStyle = xlNone
Application.FindFormat.Interior.ColorIndex = xlNone
Application.FindFormat.Locked = True
Application.FindFormat.FormulaHidden = False
Cells.FindNext(After:=ActiveCell).Activate
Selection.Cut
Range("B1622").Select
ActiveSheet.Paste
End Sub

What I need changed is between the copy and paste. I need excel to select the cell one left and one down from the cell that was cut and then paste.

I hope that clears it up a bit!!

 

[scifibum]

I haven't looked over all of your code, but in general to find a cell one down and one to the left, the Offset property is useful.

Try replacing these three lines:

Selection.Cut 
Range("B1622").Select 
ActiveSheet.Paste

With:

Selection.Cut Destination:=Selection.Offset(1,-1)

 

[TCollin6]

Thanks scifibum, that's a step in the right direction!!!

Here's a little cleared what I'm trying to do:

I have alist of raw data in Excel as below:

Supervisor Z
Representative A
Representative B
Representative C

I need to move the supervisor name to show next to all the representative names. FYI....The worksheet I'm working with has over 12,000 lines and different sized groups of supervisor and representatives. It's a toughy allright!

Thanks again for you help, it is greatly appreciated!! ray:

 

[TCollin6]

Any ideas how I make the selected cell the one that the last cell was moved to and repeat till the end of the spreadsheet?

 

[TCollin6]

bump