Save raw data in a sheet in existing excel workbook

I want to import a CSV file and save it in a Sheet in my existing excel workbook






Sub ImportRawData()


'Import Raw data


Const strFileName = "C:\Data\RawData.xlsx" '<<--Change this secotion for all region
    Dim wbkS As Workbook
    Dim wshS As Worksheet
    Dim wshT As Worksheet
   
    'Delete any Raw Data  if present previously.
    Application.DisplayAlerts = False
    For Each Sheet In ActiveWorkbook.Worksheets
          If Sheet.Name = "RawData" Then
          Sheet.Delete
          End If
    Next Sheet
    Application.DisplayAlerts = True
   
    'Insert RawData to new sheet
    Set wshT = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    Set wbkS = Workbooks.Open(Filename:=strFileName)
    Set wshS = wbkS.Worksheets(1)
    wshS.UsedRange.Copy Destination:=wshT.Range("A1")
    wbkS.Close SaveChanges:=False
    ActiveSheet.Name = "RawData"
   
    'Save the Last Row and Last Column of raw Data into a varible
   
    Dim lC As Long
    Dim LR As Long
    With ThisWorkbook.Sheets("RawData")
        lC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
   
    'Secretly save the values in a location in Automation sheet invisible to users.
   
    Sheets("Automation").Select
    ThisWorkbook.Sheets("Automation").Range("B34").Value = lC
    ThisWorkbook.Sheets("Automation").Range("B36").Value = LR
    Sheets("Automation").Select
      
End Sub

Finding difference two columns untill empty cells encountered

This piece of code will find difference between two column until it finds empty cell.




Sheets("Collateral Type Codes").Select
Sheets("Collateral Type Codes").Cells(3, 7).Value = "Difference"
For i = 4 To 100000
If IsEmpty(Sheets("Collateral Type Codes").Cells(i, 2)) Then
GoTo Label2
End If
Sheets("Collateral Type Codes").Cells(i, 7).Value = Sheets("Collateral Type Codes").Cells(i, 3).Value - Sheets("Collateral Type Codes").Cells(i, 4).Value
Next i
Label2:
ActiveSheet.Range("G3").Select
    Selection.AutoFilter
    ActiveSheet.Columns("D:D").AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlFilterValues

Creating a Pivot table using VBA

We are trying to create a vba script, where we are taking input for the Row lable, Column label,  and Value field from a metadata sheet. The Raw data is a separate sheet from which we are generating the pivots.

Below are the steps:




Sub CreatePivot()


Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim lastRow As Long
Dim lastCol As Long


'Delete Preivous Pivot Table Worksheet &amp; Insert a New Blank


Worksheet With Same Name
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Collateral Type Codes").Delete
Sheets("RawData").Select
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Collateral Type Codes"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Collateral Type Codes")
Set DSheet = Worksheets("RawData")


'Define Data Range


lastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(lastRow, lastCol)


'Define Pivot Cache


Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="MerivalPivotTable")
Dim Col1 As String
Dim Row1 As String
Dim RowArray() As String
Dim ColArray() As String
Dim Value As String
Dim ValueArray() As String
Dim Func
Row1 = Sheets("PivotMetaData").Cells(6, 3).Value
Col1 = Sheets("PivotMetaData").Cells(6, 4).Value
Value = Sheets("PivotMetaData").Cells(6, 5).Value
Func = Sheets("PivotMetaData").Cells(6, 6).Value
RowArray = Split(Row1, ",")
ColArray = Split(Col1, ",")
ValArray = Split(Value, ",")
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="MerivalPivotTable")


'Insert Row Fields


For i = 0 To UBound(RowArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(RowArray(i))
 .Orientation = xlRowField
 .Position = i + 1
End With
Next I


'Insert Column Fields


For j = 0 To UBound(ColArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ColArray(j))
 .Orientation = xlColumnField
 .Position = j + 1
End With
Next j


'Insert Data Field


If Func = "Sum" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlSum
 .NumberFormat = "#,##0"
 End With
Next k
End If


If Func = "Count" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlCount
 .NumberFormat = "#,##0"
 End With
Next k
End If


If Func = "Average" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlAverage
 .NumberFormat = "#,##0"
 End With
Next k
End If


If Func = "Max" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlMax
 .NumberFormat = "#,##0"
End With
Next k
End If


If Func = "Min" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlMin
 .NumberFormat = "#,##0"
End With
Next k
End If


If Func = "Product" Then
For k = 0 To UBound(ValArray)
With ActiveSheet.PivotTables("MerivalPivotTable").PivotFields(ValArray(k))
 .Orientation = xlDataField
 .Position = k + 1
 .Function = xlProduct
 .NumberFormat = "#,##0"
End With
Next k
End If

How to export few sheets of current workbook into a new workbook:

Here we are trying to export few sheets from our current workbook and save it in a new workbook. The new workbook should automatically replace any already available workbook (if present).

Sub ExportSheets()


Application.DisplayAlerts = False
ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Move
ActiveWorkbook.SaveAs "C:\users\AB\NewWorkbook.xlsx", FileFormat:=51, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
ActiveWorkbook.Close (True)


End Sub


Here we are using the move option, which means it will cut the sheets from the existing workbook and paste it in a new workbook and save it by the name NewWorkbook.xlsx.


The clause :
ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
ensures that the sheet will always overwrite any existing file by the same name.


And as we are keeping Application.DisplayAlerts = False
Excel will not prompt users with messages.

Import a CSV file into excel without User prompt

I was working in an end to end automation project, where I required to import a CSV file into my existing excel workbook and name it Raw Data. based on this Raw Data sheet I intend to Draw multiple pivots. This importing of CSV and generating pivots required to be iterated for nine different regions. This is a series of Blogs through which I shall be explaining the entire automation.


So without any much delay lets start with the initial part of importing of CSV file into our excel.


Sub ImportCSV()
   
    Const strFileName = "C:\Users\AB\Downloads\Sample.csv"
    Dim wbkS As Workbook
    Dim wshS As Worksheet
    Dim wshT As Worksheet
   
    'Delete any Raw Data if present previously.
    Application.DisplayAlerts = False
    For Each Sheet In ActiveWorkbook.Worksheets
          If Sheet.Name = "RawData" Then
          Sheet.Delete
          End If
    Next Sheet
    Application.DisplayAlerts = True
   
    'Insert RawData from Sample.csv
    Set wshT = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    Set wbkS = Workbooks.Open(Filename:=strFileName)
    Set wshS = wbkS.Worksheets(1)
    wshS.UsedRange.Copy Destination:=wshT.Range("A1")
    wbkS.Close SaveChanges:=False
    ActiveSheet.Name = "RawData"
End Sub


By this code sample we are importing Sample.csv from a specified location and placing it in our existing workbook and naming the sheet as RawData. We basically opening Sample.csv, copying data from it and then closing it.

Checking if the CSV file exists of not:

Sub ImportCSV()
   
    Const strFileName = "C:\Users\AB\Downloads\Sample.csv"
 
    If Dir(strFileName) <> "" Then
   
       
    Dim wbkS As Workbook
    Dim wshS As Worksheet
    Dim wshT As Worksheet
   
    'Delete any Raw Data if present previously.
    Application.DisplayAlerts = False
    For Each Sheet In ActiveWorkbook.Worksheets
          If Sheet.Name = "RawData" Then
          Sheet.Delete
          End If
    Next Sheet
    Application.DisplayAlerts = True
   
    'Insert RawData from Sample.csv
    Set wshT = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    Set wbkS = Workbooks.Open(Filename:=strFileName)
    Set wshS = wbkS.Worksheets(1)
    wshS.UsedRange.Copy Destination:=wshT.Range("A1")
    wbkS.Close SaveChanges:=False
    ActiveSheet.Name = "RawData"
     
   
Else
    Exit Sub
End If

      
End Sub