Remove Index formula once values have been inputted

L

Legacy 330376

Guest
Hi There,
I have a simple question (I hope!).

I am copying a worksheet to another worksheet using index formulas.
Now if a cell is inputted in the source worksheet, I want it to remove the index formula in the destination worksheet and just show the cell value.
I want to do this dynamically, and avoid using copy and paste special "values".
I was thinking to put the vba code in the "view code" section of the active worksheet.

Does anyone have any suggestions?

The index formula is

Code:
=IFERROR(INDEX('[MSC.xlsm]NC!$A$2:$V$2982,ROW(B50), COLUMN(B50)),0)
Thanks in advance
 

ndsutherland

Active Member
Joined
Jan 30, 2015
Messages
384
Not so easy, and it might be quite slow as this will find and loop through every formula that indexes another workbook every time you change any cell.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'adapted from code by Chip Pearson
Dim wb As Workbook, awb As Workbook, wbur As Range
Dim FoundCell As Range, LastCell As Range, FirstAddr As String
Set awb = ActiveWorkbook
Set wb = Workbooks("MSC")
Set wbur = wb.Sheets("NC").UsedRange
Set LastCell = wbur.Cells(wbur.Cells.Count)
Set FoundCell = wbur.Find(what:="[", after:=LastCell)


If Not FoundCell Is Nothing Then
    FirstAddr = FoundCell.Address
End If
Do Until FoundCell Is Nothing
    Set FoundCell = wbur.FindNext(after:=FoundCell)


    If Target.Address = Application.Evaluate(FoundCell.Formula).Address Then FoundCell.Value = FoundCell.Value: Exit Sub
    If FoundCell.Address = FirstAddr Then
        Exit Do
    End If
Loop
    
End Sub
 
L

Legacy 330376

Guest
Not so easy, and it might be quite slow as this will find and loop through every formula that indexes another workbook every time you change any cell.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'adapted from code by Chip Pearson
Dim wb As Workbook, awb As Workbook, wbur As Range
Dim FoundCell As Range, LastCell As Range, FirstAddr As String
Set awb = ActiveWorkbook
Set wb = Workbooks("MSC")
Set wbur = wb.Sheets("NC").UsedRange
Set LastCell = wbur.Cells(wbur.Cells.Count)
Set FoundCell = wbur.Find(what:="[", after:=LastCell)


If Not FoundCell Is Nothing Then
    FirstAddr = FoundCell.Address
End If
Do Until FoundCell Is Nothing
    Set FoundCell = wbur.FindNext(after:=FoundCell)


    If Target.Address = Application.Evaluate(FoundCell.Formula).Address Then FoundCell.Value = FoundCell.Value: Exit Sub
    If FoundCell.Address = FirstAddr Then
        Exit Do
    End If
Loop
    
End Sub
Hi,
Thanks for your code.
When I place it in the "view code" section of the NC tab nothing happens.

MSC is the sourced workbook.
NC is the tab of the source worksheet where I am copying the data.

NCM is the destination workbook
NC is the destination worksheet where the index formula is used.

Any ideas?
 
L

Legacy 330376

Guest
Hi,
Thanks for your code.
When I place it in the "view code" section of the NC tab nothing happens.

MSC is the sourced workbook.
NC is the tab of the source worksheet where I am copying the data.

NCM is the destination workbook
NC is the destination worksheet where the index formula is used.

Any ideas?
Hi,
I have found a solution.
Instead of using the source workbook in my code, I just applied my code on the active sheet.
The ranges are tailored to the columns, I want the index formulas to be removed in.

Thanks


Code:
Sub Macro7()
Application.ScreenUpdating = False
'
' Macro7 Macro
    Range("A3:I" & Columns("A:I").Find("*", , xlValues, , xlRows, xlPrevious).Row).Select
     Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L3:N" & Columns("L:N").Find("*", , xlValues, , xlRows, xlPrevious).Row).Select
     Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("R3:W" & Columns("R:W").Find("*", , xlValues, , xlRows, xlPrevious).Row).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("a3").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
End Sub
 

ndsutherland

Active Member
Joined
Jan 30, 2015
Messages
384
I just put the wrong workbook name in. Try

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'adapted from code by Chip Pearson
Dim wb As Workbook, awb As Workbook, wbur As Range
Dim FoundCell As Range, LastCell As Range, FirstAddr As String
Set awb = ActiveWorkbook
Set wb = Workbooks("[COLOR=#ff0000]NCM[/COLOR]")
Set wbur = wb.Sheets("NC").UsedRange
Set LastCell = wbur.Cells(wbur.Cells.Count)
Set FoundCell = wbur.Find(what:="[", after:=LastCell)


If Not FoundCell Is Nothing Then
    FirstAddr = FoundCell.Address
End If
Do Until FoundCell Is Nothing
    Set FoundCell = wbur.FindNext(after:=FoundCell)


    If Target.Address = Application.Evaluate(FoundCell.Formula).Address Then FoundCell.Value = FoundCell.Value: Exit Sub
    If FoundCell.Address = FirstAddr Then
        Exit Do
    End If
Loop
    
End Sub
 

ndsutherland

Active Member
Joined
Jan 30, 2015
Messages
384
Also, If you have more than one cell that references the same cell in your source workbook. Remove the : Exit Sub

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'adapted from code by Chip Pearson
Dim wb As Workbook, awb As Workbook, wbur As Range
Dim FoundCell As Range, LastCell As Range, FirstAddr As String
Set awb = ActiveWorkbook
Set wb = Workbooks("[COLOR=#ff0000]NCM[/COLOR]")
Set wbur = wb.Sheets("NC").UsedRange
Set LastCell = wbur.Cells(wbur.Cells.Count)
Set FoundCell = wbur.Find(what:="[", after:=LastCell)


If Not FoundCell Is Nothing Then
    FirstAddr = FoundCell.Address
End If
Do Until FoundCell Is Nothing
    Set FoundCell = wbur.FindNext(after:=FoundCell)


    If Target.Address = Application.Evaluate(FoundCell.Formula).Address Then FoundCell.Value = FoundCell.Value '[COLOR=#ff0000]: Exit Sub[/COLOR]
    If FoundCell.Address = FirstAddr Then
        Exit Do
    End If
Loop
    
End Sub
 

Forum statistics

Threads
1,085,689
Messages
5,385,184
Members
401,935
Latest member
Kepson

Some videos you may like

This Week's Hot Topics

Top