VBA Copy paste special values based on cell reference

TomRain

New Member
Joined
Apr 4, 2019
Messages
3
Hi All,

I'm having some issues with VBA. I want the code to look up cells within a range, that when greater than zero, copies and pastes adjacent columns as values in the same location (to remove the formulas).

The lookup range is J10:J371, and if greater than zero, I want adjacent cells in column J,K,L to copy and paste as values.

For example, J52 = 2000, then J52:L52 copies and pastes as values in the same place.

I saw something similar on the below thread but I can't quite get it to work on mine.

https://www.mrexcel.com/forum/excel...aste-special-values-based-cell-reference.html

Thank you in advance.
 

Some videos you may like

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
1,993
Hello and welcome

This should do what you ask:

Code:
Sub HardWriteValue()
    Dim c As Range
    For Each c In Range("J10:J371")
        If c > 0 Then
            Application.EnableEvents = False
            c = c
            c.Offset(, 1) = c.Offset(, 1)
            c.Offset(, 2) = c.Offset(, 2)
            Application.EnableEvents = True
        End If
    Next c
End Sub
 

TomRain

New Member
Joined
Apr 4, 2019
Messages
3
Hello and welcome

This should do what you ask:

Code:
Sub HardWriteValue()
    Dim c As Range
    For Each c In Range("J10:J371")
        If c > 0 Then
            Application.EnableEvents = False
            c = c
            c.Offset(, 1) = c.Offset(, 1)
            c.Offset(, 2) = c.Offset(, 2)
            Application.EnableEvents = True
        End If
    Next c
End Sub
Thank you so much for the quick response, it worked perfectly! One more thing, what would I need to add to ensure the macro does the same process across all sheets within my file simultaneously?

Thanks again.
 

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
1,993
Just loop through all worksheets:

Code:
Sub HardWriteValue()
    Dim c As Range
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        For Each c In ws.Range("J10:J371")
            If c > 0 Then
                Application.EnableEvents = False
                c = c
                c.Offset(, 1) = c.Offset(, 1)
                c.Offset(, 2) = c.Offset(, 2)
                Application.EnableEvents = True
            End If
        Next c
    Next ws
End Sub
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,096,444
Messages
5,450,488
Members
405,614
Latest member
SJ789

This Week's Hot Topics

Top