VBA Moving a cell one cell to the right

[alexfooty]

Hi
I have 21 columns of data C99:W99

I need a macro to move the orange cell (C100) one cell to the right each time the macro is run. When it eventually reaches cell W100 I need it to return to C100
Many thanks

 

[Peter_SSs]

Try

Sub Move_Cell_Down_v1()
  Dim rFound As Range
  
  'Clear any existing formatting settings for the Find process
  Application.FindFormat.Clear
  
  'Set the formatting that we want to look for (the blue cell)
  Application.FindFormat.Interior.Color = RGB(0, 176, 240)
  
  'Look in col AL for the blue cell and set rFound to be that cell
  Set rFound = Columns("AL").Find(What:="", LookIn:=xlFormulas, SearchFormat:=True)
  
  'This is just to stop the code erroring if there happens to be no blue cell
  If Not rFound Is Nothing Then
  
    'Starting 2 cells right of blue cell (rFound) and for 2 cells from that one, transfer the values from rows 25:26
    rFound.Offset(, 2).Resize(2).Value = Range("AN25:AN26").Value
    
    'Cut the Blue cell and paste it 2 cells down (or to row 40 if we are at the end)
    rFound.Cut Destination:=Cells(IIf(rFound.Row = 66, 40, rFound.Row + 2), rFound.Column)
    
  End If
  
  'Clear the blue formatting seeting from Find so that it doesn't impede any other Find operations that you might do
  Application.FindFormat.Clear
End Sub

 

[alexfooty]

Peter, still not there yet.

What this does is to only copy the 2 cells AN25:AN26 to the row where the blue cell is then move the blue cell 2 rows down.
I need it to copy the range AN25:BK26 and paste the values into AN40:BK41 then move the blue cell down 2 rows.

 

[Peter_SSs]

Sorry, I had misread that. Based on the images in post #18, just change this blue line

'Starting 2 cells right of blue cell (rFound) and for 2 cells from that one, transfer the values from rows 25:26
rFound.Offset(, 2).Resize(2, 24).Value = Range("AN25:BK26").Value

 

[alexfooty]

Brilliant. Works perfectly. Thanks again for your help.
Promise I won't bother you again!!
Alex

 

[Peter_SSs]

No problem

 

[alexfooty]

Peter, I've managed to successfully use your two macros as a template to create several other macros.
However this one is giving me problems - I'm sure there's a simple solution somewhere.
The green marker colour is rgb (112,173,71)

I need to copy the value of a cell in Sheets("Daily Hour").Range("F6") to AN40 then move along one cell. This I can manage to do - believe it or not.
The problem is that after copying to the last cell (AT40) I need to return to column AN but move one row down to row 41 and so on.
Any help would be appreciated - again!

 

[Peter_SSs]

Try this

Sub Move_Cell_Across_v1()
  Dim rFound As Range
  Dim nr As Long
  
  'Clear any existing formatting settings for the Find process
  Application.FindFormat.Clear
  
  'Set the formatting that we want to look for
  Application.FindFormat.Interior.Color = RGB(112, 173, 71)
  
  'Look in row 39 for the green cell and set rFound to be that cell
  Set rFound = Rows(39).Find(What:="", LookIn:=xlFormulas, SearchFormat:=True)
  
  'This is just to stop the code erroring if there happens to be no green cell
  If Not rFound Is Nothing Then
    
    'Find the next row
    nr = Cells(Rows.Count, rFound.Column).End(xlUp).Row + 1
    If nr <= rFound.Row Then nr = rFound.Row + 1
    
    'Copy the value from other sheet
    Cells(nr, rFound.Column).Value = Sheets("Daily Hour").Range("F6").Value
    
    'Cut the coloured cell and paste it to the next day
    rFound.Cut Destination:=rFound.Offset(, IIf(rFound.Offset(-1).Value = "SUN", -6, 1))
    
  End If
  
  'Clear the green formatting seeting from Find so that it doesn't impede any other Find operations that you might do
  Application.FindFormat.Clear
End Sub

 

[alexfooty]

When I run it the green cell moves but not copying any data over. The destination cells remain blank.

 

[Peter_SSs]

Place your cursor anywhere in the code then press F8 several times until the following line is highlighted. Then hover over 'nr' and 'rFound.column' to see what values appear in the pop-up.

Other things to check:

• Confirm that there is not any Conditional Formatting in AN40:ATxx
• Confirm that Sheets("Daily Hour").Range("F6") is not empty

 

[alexfooty]

rFound.Column=40
Cleared any condition formatting and Sheets("Daily Hour").Range("F6") is not empty
Still not copying the data over.