VBA Find and Replace other column and IF statement

[celine664]

Hi,

I have a dataset where I want the following and I am stuck. I have a datasheet, where I have clientnumbers in column E and in column Q the type of business of the client (i.e. new business, lost business or excisting business). Sometimes Column Q is not correct, so I have a correction sheet where I can fill in the concering clientnumber and the type of business it should actually be (e.g. from new business change into lost business).

1. Datasheet:
Column A: Year
Column E: Clientnumbers (e.g. number 1 till 100)
Column Q: Type of Business in dataset (e.g. new business, lost business, excisting business)

2. Correctionsheet:
Column E: Clientnumbers
Column G: Type of business in dataset
Column H: Type of business overulling

Now I have a code that corrects the Column Clientnumber into the replacement value. So in the datasheet Column C gets the value which Column Q should actually get. How do I fix this? In the below code a step "Do all replacements on Column C of data sheet" I first tried column Q, but then it looks for Clientnumbers in column Q and I dont have them there. I tried stuff with Offset, but I am not good with VBA, so perhaps someone can help me very easily. On top of that, I have the years in column A, and I only want it to replace the Business Type (Column Q) for year "2019" (Column A). So 2018 needs to stay the way it is in the dataset.


My code is as follows:

Sub TypeBusinessReplace()


    Dim myDataSheet As Worksheet
    Dim myReplaceSheet As Worksheet
    Dim myLastRow As Long
    Dim myRow As Long
    Dim myFind As String
    Dim myReplace As String
    
'   Specify name of Data sheet
    Set myDataSheet = Sheets("iPakketten2")
    
'   Specify name of Sheet with list of replacements
    Set myReplaceSheet = Sheets("Correcties")
    
'   Assuming list of replacement start in column E on row 2, find last entry in list
    myLastRow = myReplaceSheet.Cells(Rows.Count, "E").End(xlUp).Row
    
    Application.ScreenUpdating = False
    
'   Loop through all list of replacments
    
    For myRow = 2 To myLastRow
'       Get find and replace values (from columns E and H)
        myFind = myReplaceSheet.Cells(myRow, "E")
        myReplace = myReplaceSheet.Cells(myRow, "H")
'       Start at top of data sheet and do replacements
        myDataSheet.Activate
        Range("C1").Select
'       Ignore errors that result from finding no matches
        On Error Resume Next
'       Do all replacements on column C of data sheet
        Columns("C:C").Replace What:=myFind, Replacement:=myReplace, LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
'       Reset error checking
        On Error GoTo 0
    Next myRow
    
    Application.ScreenUpdating = True
    
    MsgBox "Replacements complete!"
    
End Sub

Thanks soo much!!!

 

[pbornemeier]

Option Explicit

Sub TypeBusinessReplace()


    Dim myDataSheet As Worksheet
    Dim myReplaceSheet As Worksheet
    Dim myLastRow As Long
    Dim myRow As Long
    Dim myFind As String
    Dim myReplace As String
    Dim oFound As Object
    Dim lNotFound As Long
    Dim sOutput As String
    
'   Specify name of Data sheet
    Set myDataSheet = Sheets("iPakketten2")
    
'   Specify name of Sheet with list of replacements
    Set myReplaceSheet = Sheets("Correcties")
    
'   Assuming list of replacement start in column E on row 2, find last entry in list
    myLastRow = myReplaceSheet.Cells(Rows.Count, "E").End(xlUp).Row
    
    'Clear background color from myReplaceSheet, column E
    myReplaceSheet.Columns(5).Interior.Color = xlNone
    
    myDataSheet.Activate
    Application.ScreenUpdating = False
    
'   Loop through all list of replacements
    For myRow = 2 To myLastRow
'       Get find and replace values (from columns E and H)
        myFind = CStr(myReplaceSheet.Cells(myRow, "E"))
        myReplace = CStr(myReplaceSheet.Cells(myRow, "H"))

'       Search datasheet column 5 for myfind
        Set oFound = myDataSheet.Columns("E:E").Find(What:=myFind, LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not oFound Is Nothing Then
            'Match found
            If myDataSheet.Cells(oFound.Row, 1) = 2019 Then
                'data sheet column A for that row is 2019, so update the
                '  replacements column: myDataSheet, column C
                oFound.Offset(0, -2).Value = myReplace
            End If
        Else
            'Match not found, color the not found value yellow
            myReplaceSheet.Cells(myRow, "E").Interior.Color = rgbYellow
            lNotFound = lNotFound + 1
        End If
            
    Next myRow
    
    Application.ScreenUpdating = True
    
    sOutput = "Replacements complete!"
    
    If lNotFound > 0 Then
        sOutput = sOutput & vbLf & vbLf & lNotFound & " clients were not matched."
        myReplaceSheet.Activate
    End If
        
    MsgBox sOutput
    
End Sub

Note that you are more likely to get a response if you include sample data from input worksheets and a layout of the desired results.