[Solved] open files in folder and check if there is a blank in column A then delete entire row before copy the data

[bigme]

Private Sub TarikDataKoreksi()
Dim lr, lrow, i As Long

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Sheet_Name = "Form Faktur"

'to select folder contains workbooks
Set File_Dialog = Application.FileDialog(msoFileDialogFolderPicker)
File_Dialog.AllowMultiSelect = False
File_Dialog.Title = "Select Folder"
If File_Dialog.Show <> -1 Then
Exit Sub
End If

File_Path = File_Dialog.SelectedItems(1) & "\"
File_Name = Dir(File_Path & "*.xls*")

'to open all workbook in folder and copy the data inside to sheet Monitoring Faktur
Do While File_Name <> ""
lr = Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("A" & Rows.Count).End(xlUp).Row
lr = lr + 1
Set file = Workbooks.Open(FileName:=File_Path & File_Name)

'Nomor Faktur TanggalFaktur StatusSTNK JenisKoreksi DataAwal DataPerbaikan
file.Worksheets(Sheet_Name).Range("A4:G1000").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("A" & lr).PasteSpecial Paste:=xlPasteValues

'price
file.Worksheets(Sheet_Name).Range("U4:U1000").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("H" & lr).PasteSpecial Paste:=xlPasteValues

'no surat
file.Worksheets(Sheet_Name).Range("J1").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("J" & lr).PasteSpecial Paste:=xlPasteValues

'tgl pengajuan
file.Worksheets(Sheet_Name).Range("J2").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("I" & lr).PasteSpecial Paste:=xlPasteValues

File_Name = Dir()
Loop
end sub

above is a code to open files in a folder and copy the data to other workbook and it's work fine, my curent issue is i need to insert a code to check if there any blank/empty cells in column A and delete that row if there is a blank/empty before i copy the data, please kindly hep me, thank you.


regards,
bigMe

 

[Yousuf Shovon]

above is a code to open files in a folder and copy the data to other workbook and it's work fine, my curent issue is i need to insert a code to check if there any blank/empty cells in column A and delete that row if there is a blank/empty before i copy the data, please kindly hep me, thank you.

Hello BIGME,

Glad to hear from you again. I understand you wish to insert a code to check for any blank/empty cells in column A and delete that row if there is a blank/empty before you copy the data. The method you can use to fix this is to use auto-filter to filter the rows and then take whatever action is required.

Here is the modified code:

Private Sub TarikDataKoreksi()
    Dim lr, lrow, i As Long
    Dim ws As Worksheet
    Dim r As Range
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Set ws = Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur")
    Sheet_Name = "Form Faktur"
    
    'to select folder contains workbooks
    Set File_Dialog = Application.FileDialog(msoFileDialogFolderPicker)
    File_Dialog.AllowMultiSelect = False
    File_Dialog.Title = "Select Folder"
    If File_Dialog.Show <> -1 Then
        Exit Sub
    End If
    
    File_Path = File_Dialog.SelectedItems(1) & "\"
    File_Name = Dir(File_Path & "*.xls*")
    
    'to open all workbook in folder and copy the data inside to sheet Monitoring Faktur
    Do While File_Name <> ""
        lr = ws.Range("A" & Rows.Count).End(xlUp).Row
        lr = lr + 1
        Set file = Workbooks.Open(FileName:=File_Path & File_Name)
        
        'Nomor Faktur TanggalFaktur StatusSTNK JenisKoreksi DataAwal DataPerbaikan
        file.Worksheets(Sheet_Name).Range("A4:G1000").Copy
        ws.Range("A" & lr).PasteSpecial Paste:=xlPasteValues
        
        'price
        file.Worksheets(Sheet_Name).Range("U4:U1000").Copy
        ws.Range("H" & lr).PasteSpecial Paste:=xlPasteValues
        
        'no surat
        file.Worksheets(Sheet_Name).Range("J1").Copy
        ws.Range("J" & lr).PasteSpecial Paste:=xlPasteValues
        
        'tgl pengajuan
        file.Worksheets(Sheet_Name).Range("J2").Copy
        ws.Range("I" & lr).PasteSpecial Paste:=xlPasteValues
        
        'Delete blank rows
        With ws
            .UsedRange.AutoFilter Field:=1, Criteria1:="="
            Set r = .Range(.Cells(2, 1), .Cells(.UsedRange.Rows.Count, 1))
            If r.Rows.Count > 1 Then r.Offset(1, 0).Resize(r.Rows.Count - 1).EntireRow.Delete
            .AutoFilterMode = False
        End With
        
        File_Name = Dir()
    Loop
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

I added the ws variable to refer to the "Monitoring Faktur" worksheet and used it to delete the blank rows using auto-filter as suggested in the instructions. The code filters column A for blank cells, selects the range of filtered cells except for the header row, and deletes them. Then it turns off the auto filter and continues the loop to process the next file.

Note: An alternative approach that does not require opening and updating the spreadsheet is to link to the spreadsheet and then use an append query that selects all the rows where ColumnA is not null.

Regards,
Yousuf Shovon

 

[bigme]

thank you... and more thank you for you dear Yousuf....

regards,
bigMe

 

[shamimarita]

thank you... and more thank you for you dear Yousuf....

regards,
bigMe

Dear bigMe,

You are most welcome.