1
votes

I am not that much familiar in VBA code. I am looking to implement two scenarios using VBA code in excel.

Scenario 1: If the value in the "C" column contains specific text, then replace the corresponding values in the "A" column as below If the value in C contains "abc" then A= "abc". If the value in C contains "gec" then A= "GEC".

It should loop from the second row to last non-empty row

A B C
Two abc-def
Thr gec-vdg
Thr abc-ghi

Expected Result:

A B C
abc Two abc-def
gec Thr gec-vdg
abc Thr abc-ghi

Scenario 2: If the value in the "B" column is "A", then replace all the "A" value in the B column as "Active". If the value in the "B" column is I", then replace all the I value in the B column as inactive.

It should loop from the second row to last non-empty row

A B C
abc A abc-def
gec I gec-vdg
abc A abc-ghi

Expected Result:

A B C
abc Active abc-def
gec Inactive gec-vdg
abc Active abc-ghi

I know that it is possible by using excel formulas. Wondering, how it can be implemented using vba code in excel.

2

2 Answers

0
votes

Usually people on here won't just write code for you, this is more for helping you with your code when your stuck. However I've written one for you based on the information you have provided. I've assumed your cells in column C would always have the hyphen and you always want what's left of the hyphen. If there is no hyphen or the relevant cell in column C is empty then nothing will be put into the relevant cell in column A.

I've put in to turn off ScreenUpdating for the code as I don't know how many rows you have. If it's a lot and you have a lot going on, then we can also turn off Calculation and Events to speed it up more, or run it as an array if it's really slow but I suspect that it won't be an issue.

Paste this into your relevant sheet module and change the sheet name as well as the column that's finding the last row if C isn't the right one:

Sub UpdateCells()

Application.ScreenUpdating = False

Dim i As Long, lRow As Long, ws As Worksheet

Set ws = Sheets("Sheet1") 'Change Sheet1 to your sheet name
lRow = ws.Range("C" & Rows.Count).End(xlUp).Row 'Finds your last row using Column C

With ws
    For i = 2 To lRow 'Loop from row 2 to last row
        If .Range("B" & i) = "A" Then
            .Range("B" & i) = "Active"
        ElseIf .Range("B" & i) = "I" Then
            .Range("B" & i) = "Inactive"
        End If
        If .Range("C" & i) <> "" Then
            If InStr(.Range("C" & i), "-") > 0 Then 'If current row Column C contains hyphen
                .Range("A" & i) = Left(.Range("C" & i), InStr(.Range("C" & i), "-") - 1)
            End If
        End If
    Next i
End With

Application.ScreenUpdating = True

End Sub
0
votes

Replace Values

Option Explicit

Sub replaceCustom()
    
    ' Define constants.
    Const wsName As String = "Sheet1"
    Const ColumnsAddress As String = "A:C"
    Const FirstRow As Long = 2
    Dim Contains As Variant: Contains = VBA.Array(3, 1) ' 0-read, 1-write
    Const findContainsList As String = "abc,gec" ' read
    Const replContainsList As String = "abc,gec" ' write
    Dim Equals As Variant: Equals = VBA.Array(2, 2) ' 0-read, 1-write
    Const findEqualsList As String = "A,I" ' read
    Const replEqualsList As String = "Active,Inactive" ' write
    Dim CompareMethod As VbCompareMethod: CompareMethod = vbTextCompare
    ' Define workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
    ' Define range.
    Dim rng As Range
    With wb.Worksheets(wsName).Columns(ColumnsAddress)
        Set rng = .Resize(.Worksheet.Rows.Count - FirstRow + 1) _
            .Offset(FirstRow - 1).Find( _
                What:="*", _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious)
        If rng Is Nothing Then
            Exit Sub
        End If
        Set rng = .Resize(rng.Row - FirstRow + 1).Offset(FirstRow - 1)
    End With
    ' Write values from range to array.
    Dim Data As Variant: Data = rng.Value
    ' Write lists to arrays.
    Dim findCo() As String: findCo = Split(findContainsList, ",")
    Dim replCo() As String: replCo = Split(replContainsList, ",")
    Dim findEq() As String: findEq = Split(findEqualsList, ",")
    Dim replEq() As String: replEq = Split(replEqualsList, ",")
    ' Modify values in array.
    Dim i As Long
    Dim n As Long
    For i = 1 To UBound(Data, 1)
        For n = 0 To UBound(Contains)
            If InStr(1, Data(i, Contains(0)), findCo(n), CompareMethod) > 0 Then
                Data(i, Contains(1)) = replCo(n)
                Exit For
            End If
        Next n
        For n = 0 To UBound(Equals)
            If StrComp(Data(i, Equals(0)), findEq(n), CompareMethod) = 0 Then
                Data(i, Equals(1)) = replEq(n)
                Exit For
            End If
        Next n
    Next i
    ' Write values from array to range.
    rng.Value = Data
    
End Sub