Move a cell's value and a formula reference to that cell

Question

I have several sheets in a workbook where if there are multiples of a number in a list I need to move an adjacent column over 1. This adjacent column is being used in a formula in the sheet. I want the formula to reference the value in its new position.

This is the table before the code

This is the ideal result where all the ones and fives had their numbers moved over 1 column but the formula still references the cell.

I've written:

For i = 1 To WS_Count sheet_name = ActiveWorkbook.Worksheets(i).Name row_count = Worksheets(sheet_name).Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row For x = 11 To row_count cell = ActiveWorkbook.Worksheets(sheet_name).Cells(x, 1) If cell = "" Then GoTo NextIteration If ActiveWorkbook.Worksheets(sheet_name).Cells(x - 1, 1) = ActiveWorkbook.Worksheets(sheet_name).Cells(x, 1) Or ActiveWorkbook.Worksheets(sheet_name).Cells(x + 1, 1) = ActiveWorkbook.Worksheets(sheet_name).Cells(x, 1) Then ActiveWorkbook.Worksheets(sheet_name).Cells(x, 5) = ActiveWorkbook.Worksheets(sheet_name).Cells(x, 4) ActiveWorkbook.Worksheets(sheet_name).Cells(x, 4).ClearContents End If NextIteration: Next x Next i

The cut is not working properly over the multiple sheets. It doesn't properly move to the new sheet.

Is there a way to move a cell's value and the reference to the cell from the formula over multiple sheets?

You appear to be assigning values from one cell to another. Doing so will overwrite any formula (in the destination cell) with just a static value. Instead you might want to use Range.Cut — chillin
– chillin, Commented Jan 4, 2019 at 21:26

Tim Williams · Accepted Answer · 2019-01-04 21:51:48Z

You can Cut the values over:

Dim ws As Worksheet, i As Long, x As Long, row_count As Long, v For i = 1 To WS_Count Set ws = ActiveWorkbook.Worksheets(i) row_count = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Row For x = 11 To row_count v = ws.Cells(x, 1).Value If Len(v) > 0 Then If ws.Cells(x - 1, 1) = v Or ws.Cells(x + 1, 1) = v Then ws.Cells(x, 4).Cut ws.Cells(x, 5) End If End If Next x Next i

Thank you. I attempted this before i submitted the questions but the way i set the active workbook was messing me up too. This worked great.

ruirodrigues1971__ · Accepted Answer · 2019-01-04 22:44:19Z

Why not copy the formula? https://learn.microsoft.com/en-us/office/vba/api/excel.range.formula

The algorithm

for.... if .... You can copy formula to the adjacent cell, then empty the cell

If you copy directly the formula from one cell to the another, the formula doesn't change

Collectives™ on Stack Overflow

Move a cell's value and a formula reference to that cell

2 Answers 2

1 Comment

Comments

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

Comments

Related