Link to home
Start Free TrialLog in
Avatar of Luis Diaz
Luis DiazFlag for Colombia

asked on

VBA Excel: fill / replace values based on a config sheet.

Hello experts,

Hello, I have the following procedures,

Sub lookup()

    Dim c                     As Range
    Dim vData
    Dim sCol(1 To 7)          As String
    Dim n                     As Long

    With Sheets("Sheet3")
        For n = 1 To 7
            sCol(n) = "'" & .Name & "'!" & .Range("A1").CurrentRegion.Columns(n).Address
        Next n
    End With

    With Sheets("Sheet2")

        For Each c In .Range("D1", .Range("D" & Rows.Count).End(xlUp)).Cells
            vData = .Evaluate("LOOKUP(2,1/(" & sCol(1) & "=" & c.Address & ")/isnumber(search(" & sCol(5) & "," & c.Offset(, -3).Address & "))," & sCol(4) & ")")
            If Not IsError(vData) Then c.Offset(, 12).Value = vData
        Next c

    End With
End Sub


Sub Replacement()

    Dim wksConfig As Worksheet
    Dim wks As Worksheet, ws1 As Worksheet
    Dim rng As Range
    Dim c As Range
    Dim bExists  As Boolean
    
    Set wksConfig = Worksheets("4.Parameter-Replacement")
    Application.ScreenUpdating = False
    
    For Each rng In wksConfig.Range(wksConfig.Range("C2"), wksConfig.Range("C" & Cells.Rows.Count).End(xlUp))
        bExists = Evaluate("=ISREF('" & rng.Offset(0, 1).Value & "'!A1)")
        If Not bExists Then
            MsgBox "Worksheet: '" & rng.Offset(0, 1).Value & "' is not valid"
            Exit Sub
        Else
            Set wks = Worksheets(rng.Offset(0, 1).Value)
        End If
        If rng.Offset(0, 2).Value = 2 Then
            rng.Offset(0, 3).Value = Application.WorksheetFunction.CountIf(wks.Range(wks.Range(rng.Value & "2"), wks.Range(rng.Value & wks.UsedRange.Rows.Count)), "")
            wks.Range(wks.Range(rng.Value & "2"), wks.Range(rng.Value & wks.UsedRange.Rows.Count)).Replace rng.Offset(0, -2).Value, rng.Offset(0, -1).Value, xlPart
        ElseIf rng.Offset(0, 2).Value = 1 Then
            If Not IsNumeric(rng.Offset(0, -2).Value) Then
                rng.Offset(0, 3).Value = Application.WorksheetFunction.CountIf(wks.Range(wks.Range(rng.Value & "2"), wks.Range(rng.Value & wks.Rows.Count).End(xlUp)), "*" & rng.Offset(0, -2).Value & "*")
                wks.Range(wks.Range(rng.Value & "2"), wks.Range(rng.Value & wks.UsedRange.Rows.Count)).Replace "*" & rng.Offset(0, -2).Value & "*", rng.Offset(0, -1).Value, xlWhole
            Else
                cnt = 0
                Set c = wks.Range(wks.Range(rng.Value & "2"), wks.Range(rng.Value & wks.Rows.Count).End(xlUp)).find("*" & rng.Offset(0, -2).Value & "*")
                If Not c Is Nothing Then
                    firstAddress = c.Address
                    Do
                        c.Value = rng.Offset(0, -1).Value
                        cnt = cnt + 1
                        Set c = wks.Range(wks.Range(rng.Value & "2"), wks.Range(rng.Value & wks.Rows.Count).End(xlUp)).FindNext(c)
                    Loop While Not c Is Nothing
                End If
                rng.Offset(0, 3).Value = cnt
            End If
        Else

            rng.Offset(0, 3).Value = Application.WorksheetFunction.CountIf(wks.Range(wks.Range(rng.Value & "2"), wks.Range(rng.Value & wks.Rows.Count).End(xlUp)), IIf(rng.Offset(0, 2).Value = 1, rng.Offset(0, -2).Value, "*" & rng.Offset(0, -2).Value & "*"))
            wks.Range(wks.Range(rng.Value & "2"), wks.Range(rng.Value & wks.Rows.Count).End(xlUp)).Replace rng.Offset(0, -2).Value, rng.Offset(0, -1).Value, xlPart
        End If
        'wks.Range(wks.Range(rng.Value & "2"), wks.Range(rng.Value & wks.Rows.Count).End(xlUp)).Replace rng.Offset(0, -2).Value, rng.Offset(0, -1).Value, IIf(rng.Offset(0, 2).Value = 1, xlWhole, xlPart)
    Next
    Application.ScreenUpdating = True
End Sub

Open in new window




I would like to take as a reference in order to cover the following requirement:

Based on the following Config Sheet, I would like to take as a reference values reported in column B with it respective column reported in column C and fill replace based on the destination values and destination column.

User generated image


I attached a sample with both Sheet2 and Sheet3 and how should fill the values in respective “after_exe” Sheets

Sheet2
User generated imageUser generated image

Sheet3
User generated imageUser generated image

If you have questions, don’t hesitate to contact me.
replacement_2_reference_and_destina.xlsm
Avatar of Ejgil Hedegaard
Ejgil Hedegaard
Flag of Denmark image

Try this
Sub Replace2()
    Dim wsConfig As Worksheet, wsReplace As Worksheet
    Dim rwConfig As Integer, rwReplace As Long
    Dim cnt As Long
    
    Application.ScreenUpdating = False
    Set wsConfig = Worksheets("Config")
    For rwConfig = 2 To wsConfig.Range("A1").End(xlDown).Row
        If Not Evaluate("=ISREF('" & wsConfig.Range("A" & rwConfig) & "'!A1)") Then
            MsgBox "Worksheet: '" & wsConfig.Range("A" & rwConfig) & "' is not valid"
            Exit Sub
        Else
            Set wsReplace = Worksheets(wsConfig.Range("A" & rwConfig).Value)
        End If
        cnt = 0
        For rwReplace = 2 To wsReplace.Cells.SpecialCells(xlCellTypeLastCell).Row
            If wsReplace.Range(wsConfig.Range("C" & rwConfig) & rwReplace) = wsConfig.Range("B" & rwConfig) Then
                wsReplace.Range(wsConfig.Range("D" & rwConfig) & rwReplace) = wsConfig.Range("E" & rwConfig)
                cnt = cnt + 1
            End If
        Next rwReplace
        wsConfig.Range("F" & rwConfig) = cnt
    Next rwConfig
End Sub

Open in new window

Avatar of Luis Diaz

ASKER

Thank you very much for this proposal.

I tested and it works!
Something that I forgot which can help me a lot is to add a last column with "Skip line" if the related line has a value equal to 1 the procedure should go the next line else take into account the line.


In the following example line 2 should be skipped and just line 3 should be taken into account.

User generated image
Do you think it can be possible to add this to your procedure?

Thank you again for your help.
ASKER CERTIFIED SOLUTION
Avatar of Ejgil Hedegaard
Ejgil Hedegaard
Flag of Denmark image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
It works!

Thank you again for your help!!!!!
Sorry for the delay I thought I was select the question as Best Solution.

Thank you again for your help.