Creating a macro with If statements for data quality improvement

[Henceman]

The purpose of the macro, is to fix the data where it is invalid.


I need to have macro to evaluate a few terms, fix if needed and add a comment of the fix.


My logic how to check it goes as follows, Im just not able to write it into VBA.

1.) Marcro runs and checks D column (we could use table name instead of D:D?) for "Z5" value.

2)If Z5 value is found, it checks, whether the partner sub unit value is the same as sellers

a)If partner subunit name is the same, it performs the check for PG, if these match as well, macro continues down to find another row with Z5
b)if partner subunit name is something different, macro owerwrites the current value with the name taken from seller sub unit and checks PG for match as well if same correction needs to be done.

3)If either partner subunit name AND/OR PG needs to be altered, macro writes comment, example written in the image, but it could contain what was changed as well...


I believe maximum amount of rows macro needs to check is max 100 000, so quite a lot....

thank you for ideas!

 

[pbornemeier]

Option Explicit

Sub CheckValues()
    'https://www.mrexcel.com/board/threads/creating-a-macro-with-if-statements-for-data-quality-improvement.1118023/
    
    Dim lLastRow As Long
    Dim lRowIndex As Long
    Dim varF As Variant
    Dim varG As Variant
    Dim varK As Variant
    Dim varL As Variant
    Dim lChangeCount As Long
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    If Cells(Rows.Count, 15).End(xlUp).Row > 1 Then
        MsgBox "There is at least one comment in column O." & vbLf & vbLf & _
            "Manually delete column O values to continue or edit code to allow overwrite.", , _
            "Comments Already Exist"
        GoTo End_Sub
    End If
    
    For lRowIndex = 2 To lLastRow
        If Cells(lRowIndex, 4).Value = "Z5" Then
            varF = Cells(lRowIndex, 6).Value
            varG = Cells(lRowIndex, 7).Value
            varK = Cells(lRowIndex, 11).Value
            varL = Cells(lRowIndex, 12).Value
            
            'Sub Unit Check
            If varF <> varK Then
                
                'Set column F = K
                Cells(lRowIndex, 6).Value = varK
                'Update column O
                Cells(lRowIndex, 15).Value = "TP SU changed from " & _
                    varF & " to " & varK
                lChangeCount = lChangeCount + 1
            End If
            'PG Check
            If varG <> varL Then
                'Set column G = L
                Cells(lRowIndex, 7).Value = varL
                'Update column O
                If Len(Cells(lRowIndex, 15).Value) > 0 Then
                    Cells(lRowIndex, 15).Value = Cells(lRowIndex, 15).Value & _
                        "/PG Changed from " & varG & " to " & varL
                Else
                    Cells(lRowIndex, 15).Value = "TP PG changed from " & varG & " to " & varL
                End If
                lChangeCount = lChangeCount + 1
            End If
        End If
    Next
    If lChangeCount > 0 Then
        MsgBox "Check completed,  " & lChangeCount & " changes made."
    Else
        MsgBox "Check completed, no changes made."
    End If
End_Sub:

End Sub

 

[mumps]

If you can have up to 100 000 rows, I think that loading your data into an array would work quite quickly. It is hard to work with a picture. Could you upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data. Also, I noticed that there are some comments in column M. Do you want the macro to insert those comments as well as those in column O?

 

[Henceman]

Hello all and sorry for long absence, since I got a different result working, which I paste now here:

Sub Z5m()
Dim rng As Range, cell As Range
Dim lRow As Long: lRow = Cells(Rows.Count, 4).End(xlUp).Row

Set rng = Range("E4500:E10000")

Call LMode(True)
On Error GoTo handler:

For Each cell In rng
If cell.Value = "Z5" Then
If cell.Offset(0, 5).Value <> cell.Offset(0, 19).Value Then
cell.Offset(0, 5).Value = cell.Offset(0, 19).Value
cell.Offset(0, 30).Value = "AAG Z5, buyer SU replaced with seller SU"
End If
If cell.Offset(0, 6).Value <> cell.Offset(0, 20).Value Then
cell.Offset(0, 6).Value = cell.Offset(0, 20).Value
cell.Offset(0, 30).Value = Trim(cell.Offset(0, 6).Value & " AAG Z5, buyer PG replaced with seller PG.")
End If
End If
Next cell

handler:
Call LMode(False)

End Sub
Public Sub LMode(ByVal Toggle As Boolean)
Application.ScreenUpdating = Not Toggle
Application.EnableEvents = Not Toggle
Application.DisplayAlerts = Not Toggle
Application.Calculation = IIf(Toggle, xlCalculationManual, xlCalculationAutomatic)
End Sub

When I compare the codes, then this version is MUCH faster, but for both cases I need to specify the macro range, so if for example I have 50 000 rows and I need to run it only for rows 40000-50000 which are new, then without writing it in the code, the excel will run a long time...

Another issue I ran into with both codes, is that I need to set the PG values to equal out if they are in text format, but actually the same, these values formatted as text in the picture should not be changed by the macro. Changing is only needed for values which are numerically different or missing alltogether.