vba hardcode if text string matches

Question

Hi all,

First time posting for me and hoping to get some help with  for selective hardcoding.

I currently have a column into which a formula is set which returns either blank or a variety of text strings (the status of our company's orders). 

I need to make a macro that looks into all the cells of that column and copy/pastes as value into that same cell only if the formula in that cell returns text string "Received". It should not affect the other cells where the formula is returning either blank or a different text string. 

Would really appreciate your help. Please let me know if you need more info. 

Thanks in advance,

Olivier

Answer 1

Olivier,

Try this macro:

Sub mymacro()

Dim cell As Range

For Each cell In Selection.Cells

If Not (IsError(cell.Value)) Then

If cell.Value = "Received" Then

cell.Formula = cell.Value

End If

End If

Next

End Sub

To use the macro, first, select your range of cells to scan. Then run the macro.

The macro will loop through each cell in your selection, and replace the formula with the value when the formula returns "Received".

Regards,

Edwin Tam

Excel Power Expander - http://www.vonixx.com

Answer 2

One way:

Assuming you're going to run the macro manually, and that the column is column J, put this in a regular code module:

Public Sub LockIn()

Const csLockText As String = "Received"

Dim rCell As Range

Dim rLookIn As Range

With Worksheets("Sheet1")

On Error Resume Next

Set rLookIn = Intersect(.Range("J:J"), .UsedRange)

On Error GoTo 0

If Not rLookIn Is Nothing Then

For Each rCell In rLookIn

With rCell

If .Text = csLockText Then .Value = csLockText

End With

Next rCell

End If

End With

End Sub

Adjust "Sheet1" and the "J"s as needed.

If, on the other hand, you want to lock the value in as soon as it's calculated, put this in the worksheet code module:

Private Sub Worksheet_Calculate()

Const csLockText As String = "Received"

Dim rCell As Range

Dim rLookIn As Range

On Error GoTo Err_Handler

Application.EnableEvents = False

With Me

Set rLookIn = Intersect(.Range("J:J"), .UsedRange)

If Not rLookIn Is Nothing Then

For Each rCell In rLookIn

With rCell

If .Text = csLockText Then .Value = csLockText

End With

Next rCell

End If

End With

Exit_Sub:

Application.EnableEvents = True

Exit Sub

Err_Handler:

Resume Exit_Sub

End Sub