CODEWITHSUNDEEP
excelvba
Alin-Iustinian Toderita
Alin-Iustinian Toderita

Reputation: 37

Export .csv only sheets with data (other than header)

I was creating a VBA code which extract payments made by my company from different bank accounts to other clients on various banks. This payments are stored in a single sheet. I was creating a code to extract the payments made from each bank (two so far)in the format required by the banks in separate sheets and then export the data in .csv files (one for each bank). The idea is that I wanna create a .csv file for a bank only if there are payments made on that day from that bank. If not, this command of creating a .csv file will not be executed. Please find below the code:

Private Sub Import_banci_Click()

Import_banci.Width = 150
Import_banci.Height = 33
Import_banci.Font.Size = 11

Dim import_bt As Worksheet, import_brd As Worksheet
Dim plati_lastRow As Long
Dim row As Integer

Set plati = Sheets("Plati")
plati_lastRow = plati.Cells(Rows.Count, 1).End(xlUp).row

'Creare sheet BT
Sheets.Add.Name = "import_BT"
Set import_bt = Sheets("import_BT")

'Cap de tabel
import_bt.Cells(1, 1) = "OrderNumber"
import_bt.Cells(1, 2) = "SourceAccountNumber"
import_bt.Cells(1, 3) = "TargetAccountNumber"
import_bt.Cells(1, 4) = "BeneficiaryName"
import_bt.Cells(1, 5) = "BeneficiaryBankBIC"
import_bt.Cells(1, 6) = "BeneficiaryFiscalCode"
import_bt.Cells(1, 7) = "Amount"
import_bt.Cells(1, 8) = "PaymentRef1"
import_bt.Cells(1, 9) = "PaymentRef2"
import_bt.Cells(1, 10) = "ValueDate"
import_bt.Cells(1, 11) = "Urgent"

'Format
import_bt.Range("A1:K1").Font.Bold = True
import_bt.Range("A:K").ColumnWidth = 20
import_bt.Range("A1:K1").VerticalAlignment = xlCenter
import_bt.Range("A1:K1").HorizontalAlignment = xlCenter
import_bt.Columns("A:E").NumberFormat = "@"
import_bt.Columns("F").NumberFormat = "0"
import_bt.Columns("G").NumberFormat = "0.00"
import_bt.Columns("H:I").NumberFormat = "@"
import_bt.Columns("H:I").NumberFormat = "@"
import_bt.Columns("J").NumberFormat = "dd/mm/yyyy"
import_bt.Columns("K").NumberFormat = "@"

'Creare sheet BRD
Sheets.Add.Name = "import_BRD"
Set import_brd = Sheets("import_BRD")

'Cap de tabel
import_brd.Cells(1, 1) = "Banca platitor"
import_brd.Cells(1, 2) = "IBAN Platitor"
import_brd.Cells(1, 3) = "Nume platitor"
import_brd.Cells(1, 4) = "Cod fiscal platitor"
import_brd.Cells(1, 5) = "Banca beneficiar"
import_brd.Cells(1, 6) = "IBAN Beneficiar"
import_brd.Cells(1, 7) = "Nume Beneficiar"
import_brd.Cells(1, 8) = "Cod fiscal beneficiar"
import_brd.Cells(1, 9) = "Numar OP"
import_brd.Cells(1, 10) = "Data"
import_brd.Cells(1, 11) = "Valuta (RON)"
import_brd.Cells(1, 12) = "Suma"
import_brd.Cells(1, 13) = "Detalii 1"
import_brd.Cells(1, 14) = "Detalii 2"
import_brd.Cells(1, 15) = "Detalii 3"
import_brd.Cells(1, 16) = "Detalii 4"
import_brd.Cells(1, 17) = "Urgent"
import_brd.Cells(1, 18) = "Plata buget"

'Format
import_brd.Range("A1:R1").Font.Bold = True
import_brd.Range("A:R").ColumnWidth = 20
import_brd.Range("A1:R1").VerticalAlignment = xlCenter
import_brd.Range("A1:R1").HorizontalAlignment = xlCenter
import_brd.Columns("A:C").NumberFormat = "@"
import_brd.Columns("D").NumberFormat = "0"
import_brd.Columns("E:G").NumberFormat = "@"
import_brd.Columns("H").NumberFormat = "0"
import_brd.Columns("J").NumberFormat = "dd.mm.yyyy"
import_brd.Columns("K").NumberFormat = "@"
import_brd.Columns("L").NumberFormat = "0.00"
import_brd.Columns("M:S").NumberFormat = "@"

Set cod = Sheets("cod_benef")

For i = 2 To plati_lastRow
    If InStr(plati.Cells(i, 9), "BTRL") Then
            import_bt.Cells(i, 1) = plati.Cells(i, 1)
            import_bt.Cells(i, 2) = plati.Cells(i, 9)
            import_bt.Cells(i, 3) = plati.Cells(i, 10)
            import_bt.Cells(i, 4) = plati.Cells(i, 3)
            import_bt.Cells(i, 5) = Application.VLookup(Mid(plati.Cells(i, 10), 5, 4), cod.Range("B:C"), 2, False)
            If InStr(plati.Cells(i, 10), "TREZ") Then
            import_bt.Cells(i, 6) = plati.Cells(i, 11)
            Else: import_bt.Cells(i, 6) = ""
            End If
            import_bt.Cells(i, 7) = plati.Cells(i, 6)
            import_bt.Cells(i, 8) = Left(plati.Cells(i, 5), 100)
            import_bt.Cells(i, 9) = Mid(plati.Cells(i, 5), 101, 100)
            import_bt.Cells(i, 10) = plati.Cells(i, 8)
            import_bt.Cells(i, 11) = "F"
            
         
    ElseIf InStr(plati.Cells(i, 9), "BRDE") Then
            import_brd.Cells(i, 1) = "BRDE"
            import_brd.Cells(i, 2) = plati.Cells(i, 9)
            import_brd.Cells(i, 3) = "ABC Asigurari Reasigurari SA"
            import_brd.Cells(i, 4) = "9438013"
            import_brd.Cells(i, 5) = Mid(plati.Cells(i, 10), 5, 4)
            import_brd.Cells(i, 6) = plati.Cells(i, 10)
            import_brd.Cells(i, 7) = plati.Cells(i, 3)
            import_brd.Cells(i, 8) = plati.Cells(i, 11)
            import_brd.Cells(i, 9) = plati.Cells(i, 1)
            import_brd.Cells(i, 10) = plati.Cells(i, 8)
            import_brd.Cells(i, 11) = "RON"
            import_brd.Cells(i, 12) = plati.Cells(i, 6)
            import_brd.Cells(i, 13) = Left(plati.Cells(i, 5), 35)
            import_brd.Cells(i, 14) = Mid(plati.Cells(i, 5), 36, 35)
            import_brd.Cells(i, 15) = Mid(plati.Cells(i, 5), 71, 35)
            import_brd.Cells(i, 16) = Mid(plati.Cells(i, 5), 106, 35)
            import_brd.Cells(i, 17) = plati.Cells(i, 12)
            If InStr(plati.Cells(i, 10), "TREZ") Then
                import_brd.Cells(i, 18) = "Yes"
            Else: import_brd.Cells(i, 18) = ""
            End If
    End If
        
Next i

'Stergere randuri goale import_bt
Dim lr As Long

lr = import_bt.Range("A" & Rows.Count).End(xlUp).row
    With import_bt.Range("A1:K" & lr)
        .AutoFilter
        .AutoFilter Field:=2, Criteria1:="="
        .AutoFilter Field:=3, Criteria1:="="
        .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
    End With

'Stergere randuri goale import_brd
Dim lz As Long

lz = import_brd.Range("A" & Rows.Count).End(xlUp).row
    With import_brd.Range("A1:R" & lr)
        .AutoFilter
        .AutoFilter Field:=2, Criteria1:="="
        .AutoFilter Field:=3, Criteria1:="="
        .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
    End With


'Data si timp
Dim currentDate: currentDate = Format(Now(), "DD-MM-YYYY hh mm AMPM")

Dim wb As Workbook
Set wb = Workbooks.Add
import_bt.Copy Before:=wb.Worksheets(1)
wb.SaveAs Filename:=ThisWorkbook.Path & "\import_bt" & "#" & currentDate & ".csv", FileFormat:=xlCSV, CreateBackup:=False, Local:=False
import_brd.Copy Before:=wb.Worksheets(1)
wb.SaveAs Filename:=ThisWorkbook.Path & "\import_brd" & "#" & currentDate & ".csv", FileFormat:=xlCSV, CreateBackup:=False, Local:=True
wb.Close False

import_bt.Delete
import_brd.Delete

End Sub

Thanks.

Upvotes: 0

Views: 39

Answers (1)

Super Symmetry
Super Symmetry

Reputation: 2875

If I understood correctly, all you need is a test if the last row of your sheet is greater than 1. With regards to deleting the sheets at the end of your code, it is not clear exactly what doesn't work. However, when deleting sheets you should always supress alerts to stop excel showing you messages like "Microsoft Excel will permanently delete this sheet. Do you want to continue?". Anyway, try this code and see if it did the trick. Please replace all lines from Dim wb As Workbook to import_brd.Delete

Dim wb As Workbook
Dim lLastRow As Long
Set wb = Workbooks.Add
With import_bt
  lLastRow = .Cells(.Rows.Count, 1).End(xlUp).row
  If lLastRow > 1 Then
    import_bt.Copy Before:=wb.Worksheets(1)
    wb.SaveAs Filename:=ThisWorkbook.Path & "\import_bt" & "#" & currentDate & ".csv", FileFormat:=xlCSV, CreateBackup:=False, Local:=False
  End If
End If
With import_brd
  lLastRow = .Cells(.Rows.Count, 1).End(xlUp).row
  If lLastRow > 1 Then
    import_brd.Copy Before:=wb.Worksheets(1)
    wb.SaveAs Filename:=ThisWorkbook.Path & "\import_brd" & "#" & currentDate & ".csv", FileFormat:=xlCSV, CreateBackup:=False, Local:=True
  End If
End With
wb.Close False

Application.DisplayAlerts = False
import_bt.Delete
import_brd.Delete
Application.DisplayAlerts = True

Side notes: I find that you code is logical and readable. However, you really should think about abstracting out parts of the code that you are repeating. For example the part of adding headings and applying cell formatting should really be done in different subroutines/functions. Even better, why not have ready made sheet templates for each bank with all its headings and formatting as permanent parts of your application (and hide them if you don't want them to be visible) and your code will only be responsible of extracting data. Just imagine how your code (in the current format) is going to look like if you add another bank or 2 (or may be 10). Hope this helps.

Upvotes: 1

Related Questions