Data Cleansing and Folder & Files Creation — Using Excel Macros

In this project, I’ve automated a business process in which we receive an SAP data in xlsx format and we want to generate 35 different files from the data based on the voucher id filter so that each file has only 1 voucher id (country code).

Portfolio Files - Google Drive

In the below video I’ve explained the business process, VBA code and have also shown the results.

1. Nested if formula condition 1.

=IF(OR(A2=4,A2=19,A2=7),"Remove",IF(OR(RIGHT(C2,2)=40,LEFT(C2,2)=58),"Remove",""))

2. Nested if formula condition 2.

=IF(A2=9,IF(LEFT(B2,2)=40,"",IF(LEFT(B2,2)=80,"Problem","")),"")

3. Nested if formula with AND/OR, Isnumber and search text.

=IF(AND(D2=1014448,F2="NA"),IF(ISNUMBER(SEARCH("GST",K2)),"",IF(ISNUMBER(SEARCH("VAT",K2)),"","Problem")),"")

The below code is for step 2 : Initial Checking of the data

Sub Initial_checking()

On Error GoTo errorhandlor

Application.ScreenUpdating = False

Dim lastrow As Long 'declaring variable for lastrow

Sheets("Data").Select

lastrow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row 'Finding out lasrow

Range("L1").Value = "Removing 3 general ledger" 'Column Names
Range("M1").Value = "Checking P Entry" 'Column Names
Range("N1").Value = "Checking manual entry" 'Column Names


    Range("L2").Select ' Nested if conditional Formula 1
    ActiveCell.FormulaR1C1 = _
        "=IF(OR(RC[-11]=4,RC[-11]=19,RC[-11]=7),""Remove"",IF(OR(RIGHT(RC[-9],2)=40,LEFT(RC[-9],2)=58),""Remove"",""""))"
    Selection.AutoFill Destination:=Range("L2:L" & lastrow)
    
    Range("M2").Select 'Nested if conditional Formula 2
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-12]=9,IF(LEFT(RC[-11],2)=40,"""",IF(LEFT(RC[-11],2)=80,""Problem"","""")),"""")"
    Selection.AutoFill Destination:=Range("M2:M" & lastrow)
    
    Range("N2").Select 'Nested if & search text conditional Formula 3
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-10]=1014448,RC[-8]=""NA""),IF(ISNUMBER(SEARCH(""GST"",RC[-3])),"""",IF(ISNUMBER(SEARCH(""VAT"",RC[-3])),"""",""Problem"")),"""")"
    Selection.AutoFill Destination:=Range("N2:N" & lastrow)
 
    Selection.AutoFilter
    On Error Resume Next
    
    ActiveSheet.Range("$A$1:$N$9999").AutoFilter Field:=12, Criteria1:="Remove"
    ActiveSheet.Range("A2:N" & lastrow).SpecialCells(xlCellTypeVisible).Select
    Selection.EntireRow.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Selection.AutoFilter
    Range("A1").Select
    On Error GoTo 0

Application.ScreenUpdating = True

MsgBox "The Initial checks have been successfully completed.", vbInformation, "Excel based Automation"

Exit Sub

errorhandlor:
MsgBox "There has been an error. Kindly check the input file and re-start the initial process from Begining", vbCritical, "Excel VBA Automation"



End Sub

The below code is for step 3 : Generate Files

Option Explicit
Dim datalastrow As Long


Sub Generate_files()

Application.ScreenUpdating = False

'declaring variables
Dim i As Long
Dim backendxrow As Long
Dim datalastrow As Long
Dim xrow As Long
Dim numberCC As Long
Dim Backlastrow As Long
Dim regionname As String
Dim regionnamesid As String

datalastrow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row

Backlastrow = Sheets("Backend").Range("A" & Rows.Count).End(xlUp).Row

Sheets("Data").Select

    Columns("L:N").Select
    Selection.Delete Shift:=xlLeft

'The loop will start here


backendxrow = 2

For i = 1 To Backlastrow - 1

regionname = Sheets("Backend").Range("A" & backendxrow).Value
regionnamesid = Sheets("Backend").Range("B" & backendxrow).Value

numberCC = Sheets("Backend").Range("D" & backendxrow).Value

If numberCC > 0 Then

Sheets("Data").Select
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AK$9999").AutoFilter Field:=1, Criteria1:=regionname
    ActiveSheet.Range("A1:AK" & datalastrow).SpecialCells(xlCellTypeVisible).Select
    Selection.EntireRow.Select
    Selection.Copy
    
    Workbooks.Open Filename:= _
        "C:\Users\rdang01\Desktop\File Creation by Excel/" & regionname & "_" & regionnamesid & ".xlsx"

    
   ' Sheets("Sheet1").Name = regionname & "_" & regionnamesid
    ActiveCell.Select
    Cells.Select
    Selection.ClearContents
    Windows("File Creation based on filters macro.xlsm").Activate
    Selection.Copy
    Windows(regionname & "_" & regionnamesid & ".xlsx").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWorkbook.Save
    ActiveWindow.Close
    
    Windows("File Creation based on filters macro.xlsm").Activate
    
    Sheets("Data").Select
    Range("A1").Select
Selection.AutoFilter

Else

End If

backendxrow = backendxrow + 1


Next i



Application.ScreenUpdating = True

MsgBox "The files have been sucessfully created", vbInformation, "FST Automation"


End Sub