Delete blank rows from Excel table - vba

Question

I have code the merges multiple excel workbooks together, and updates the data into another workbook "Master", however, when it paste the data into the master it leaves numerous blank rows prior to the insert of the data table.
I have tried various posted solutions, however, when I incorporate the new code it is failing. I could use some assistances in modifying my code to handle the removal of the inserted blank rows in my table, prior to the data being updated.
See '>>>>>>>>> marked in the code.
Public Function MergeMultipleSheets()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, FNum As Long
Dim myBook As Workbook, wbMaster As Workbook
Dim BaseWks As Worksheet, ws As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
Dim rng As Range, SearchValue As String
Dim FilterField As Integer, RangeAddress As String
Dim ShName As Variant, ShNames As Variant, RwCount As Long, nName As Variant
Dim nFilter As String
Dim currentrow As Long
Dim LastRow As Long
MyPath = ThisWorkbook.Sheets("Data Input").Range("B1")
' ShNames = Array("ProjSum", "FinSum", "CommSum", "InvPlan", "ResPlan_Data")
ShNames = Array("ProjSum", "ResPlan_Data")
Set wbMaster = ActiveWorkbook
'**********************************************************
'Merge data into existing worksheets in this workbook
'**********************************************************
' Add a slash after MyPath if needed.
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
' If there are no Excel files in the folder, exit.
'FilesInPath = Dir(MyPath & "week*.xl*")
nFilter = ThisWorkbook.Sheets("Data Input").Range("B2")
If nFilter = "" Or FilesInPath = "" Then
FilesInPath = Dir(MyPath & "*.xl*")
End If
' Fill the myFiles array with the list of Excel files in the
' folder.
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop
' Change application properties.
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
' Clear data from summary worksheets
For Each ShName In ShNames
Set rng = Nothing
On Error Resume Next
Set rng = wbMaster.Worksheets(ShName).UsedRange
On Error GoTo 0
If Not rng Is Nothing Then
'Don't delete header labels in the first row
Set rng = rng.Offset(1, 0)
End If
Next
rnum = 1
' Loop through all files in the myFiles array.
If FNum > 0 Then
For FNum = LBound(MyFiles) To UBound(MyFiles)
Set myBook = Nothing
On Error Resume Next
Set myBook = Workbooks.Open(MyPath & MyFiles(FNum), UpdateLinks:=0)
'**************************************************************************************************
'Removes unused Named Ranges from Name Manager from the Various JC files to prevent error dialogs.
'**************************************************************************************************
For Each nName In Names
If InStr(1, nName.RefersTo, "#REF!") > 0 Then
nName.Delete
End If
If InStr(1, nName.RefersTo, "https://") > 0 Then
nName.Delete
End If
Next nName
On Error GoTo 0
If Not myBook Is Nothing Then
For Each ShName In ShNames
Set ws = Nothing
On Error Resume Next
Set ws = myBook.Worksheets(ShName)
On Error GoTo 0
'****************************************************************************************************************************
'Calls function to update ResPlan in active workbook
'Executes Updating of the ResPlan data to proper format for extraction of data in correct format
'****************************************************************************************************************************
If ShName = "ResPlan_Data" Then
Call UnpivotResPlan
myBook.Save
End If
'**************************************************
'Updates template data per shName
'*************************************************
'>>>>>>>>>
If Not ws Is Nothing Then
Set BaseWks = wbMaster.Worksheets(ShName)
Set sourceRange = ws.UsedRange
'Exclude header labels
Set rng = sourceRange.Offset(1, 0).Resize(sourceRange.Rows.Count - 1, sourceRange.Columns.Count)
rng.ClearContents
Dim rngBlanks As Excel.Range
With wbMaster.Worksheets(ShName).ListObjects("Res_Plan_Data")
On Error Resume Next
Set rngBlanks = Intersect(.DataBodyRange, .ListColumns("New").Range).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rngBlanks Is Nothing Then
rngBlanks.Delete
End If
End With
RwCount = rng.Rows.Count
rnum = BaseWks.Cells(BaseWks.Rows.Count, 1).End(xlUp).Row + 1
BaseWks.Cells(rnum, "A").Resize(RwCount).Value _
= myBook.Name
BaseWks.Cells(rnum, "B").Resize(RwCount, rng.Columns.Count).Value = rng.Value
End If
Next
' Close the workbook without saving.
myBook.Close savechanges:=True
End If
' Open the next workbook.
Next FNum
' Set the column width in the new workbook.
BaseWks.Columns.AutoFit
'Prepares Salary Detail for Updating.
Call UnpivotSalaryDetail
End If
Call Reset
' ActiveWorkbook.Model.Refresh
If Worksheets("Resplan_Data").Visible = True Then
Worksheets("Resplan_Data").Visible = False
End If
MsgBox "Update completed!"
' Restore the application properties.
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Function
Sub ClearBlankCellsInColumnNew()
Dim rngBlanks As Excel.Range
With Worksheets("ResPlan_Data").ListObjects("Res_Plan_Data")
On Error Resume Next
Set rngBlanks = Intersect(.DataBodyRange, .ListColumns("New").Range).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rngBlanks Is Nothing Then
rngBlanks.Delete
End If
End With
End Sub

Answer 1

Not sure if this is what you are after but it will delete all the rows which have a blank cell in column A
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
A quick explination Columns("A:A") is the target column, change the letter and add numbers or varibles as you wish. .SpecialCells(xlCellTypeBlanks) is what cell it will target, in this case it will be the blank cells (record a macro and press Ctrl + G for any variations you need). And lastly .EntireRow.Delete will delete the target row(s).
So it will look in column A, and if there is any blank cells in column A it will delete that row.
Hope this helps, leave a comment if you need anything clarifed