Delete entire row after row 3 if...

[jskasango]

Hi, I have a working code that stacks multiple sheets and want to insert a line to delete entire row after row3 if cell in column EA is <1, empty or Non-numeric.
Any help will be greatly appreciated.
Thanks in advance.

 

[RayFrye]

What code have you tried to solve your problem? Post the subroutine and someone will try and debug it for you.

 

[jskasango]

Here is my code. The issue arises at line 99.

Sub StackResults()
Dim LastRow As Long
Dim xWS As Worksheet, xTWB As Workbook, DestSheet As Worksheet, Head As Range
Dim xStrAWBName As String, FolderName As String, sItem As String, Header As Long
Dim FolderPath As String, fldr As FileDialog, Lr As Long, LCD As Long, r As Long
Dim os As Long, LrS As Long, LCS As Long, FileName As String, DD As Long, FN2 As String
Dim N As Long, T As Long, N2 As Long
On Error Resume Next
Set xTWB = ThisWorkbook
Worksheets.Add
Set DestSheet = xTWB.ActiveSheet

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder containing files to merge"
.AllowMultiSelect = False
'.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
FolderName = sItem
DD = InStrRev(FolderName, "\")
FN2 = Right(FolderName, Len(FolderName) - DD)
Set fldr = Nothing
FolderPath = FolderName & "\"
T = CountFilesInFolder(FolderPath, "*.xls*")
FileName = Dir(FolderPath & "*.xls*")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name
N = N + 1
For Each xWS In ActiveWorkbook.Sheets
If xWS.Name = "Results" Then
Sheets("Results").Range("ED1:EQ1").Copy (Sheets("Results").Range("ED2"))
Lr = DestSheet.Range("A" & Rows.Count).End(xlUp).Row
LrS = xWS.Range("A" & Rows.Count).End(xlUp).Row
LCS = xWS.Cells(1, Columns.Count).End(xlToLeft).Column + 1
LCD = DestSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
If Lr = 1 Then

Range(DestSheet.Cells(0, 2), DestSheet.Cells(2, LCS)).Value = Range(xWS.Cells(1, 1), xWS.Cells(2, LCS - 1)).Value
DestSheet.Range("A1").Value = "FileName"
End If
Set Head = xWS.Range("A1")
For os = 0 To xWS.Cells(2, Columns.Count).End(xlToLeft).Column - 1
On Error Resume Next
Header = 0
Header = WorksheetFunction.Match(Head.Offset(0, os), DestSheet.Rows(1), 0)
On Error GoTo 0
If Header = 0 Then
DestSheet.Cells(1, LCD) = Head.Offset(0, os)
Header = LCD
LCD = LCD + 1
End If
If Lr = 1 Then
N2 = (N - 1) * LCS + os + 1
Application.StatusBar = "Importing Data.. " & Round(N2 * 100 / (T * LCS), 2) & "% Completed"
UserForm1.Text.Caption = Round(N2 * 100 / (T * LCS), 2) & "% Completed"
UserForm1.Bar.Width = Round(N2 * 100 / (T * LCS), 2) * 4.8
DoEvents
Range(DestSheet.Cells(Lr + 2, Header), DestSheet.Cells(Lr + LrS - 1, Header)).Value = Range(xWS.Cells(25, os + 1), xWS.Cells(LrS, os + 1)).Value
Else
N2 = (N - 1) * LCS + os + 1
Application.StatusBar = "Importing Data.. " & Round(N2 * 100 / (T * LCS), 2) & "% Completed"
UserForm1.Text.Caption = Round(N2 * 100 / (T * LCS), 2) & "% Completed"
UserForm1.Bar.Width = Round(N2 * 100 / (T * LCS), 2) * 4.8
DoEvents
Range(DestSheet.Cells(Lr + 1, Header), DestSheet.Cells(Lr + LrS - 2, Header)).Value = Range(xWS.Cells(3, os + 1), xWS.Cells(LrS, os + 1)).Value
End If
Next os
If Lr = 1 Then
Range(DestSheet.Cells(Lr + 2, 1), DestSheet.Cells(Lr + LrS - 1, 1)).Value = Left(FileName, Application.WorksheetFunction.Find(".", FileName) - 1)
Else
Range(DestSheet.Cells(Lr + 1, 1), DestSheet.Cells(Lr + LrS - 2, 1)).Value = Left(FileName, Application.WorksheetFunction.Find(".", FileName) - 1)
End If
End If
Next xWS
Workbooks(xStrAWBName).Close
FileName = Dir()
Loop
UserForm1.Text.Caption = "100% Completed"
UserForm1.UnloadThisForm
DestSheet.Activate
DestSheet.Name = "xStrAWBName"
Columns("A:EA").EntireColumn.AutoFit

'================================================== rows with BLANK,NON-NUMERI OR <1


'THIS IS WHERE I NEED ENTIRE ROW DELETE IF COLUMN EA, STARTING FROM ROW 2 IS BLANK,NON-NUMERI OR <1.


'================================================== rows with BLANK,NON-NUMERI OR <1



On Error Resume Next
Rows("2:2").Select
Range("A2").EntireRow.Insert
'Rows("3:3").Select
Selection.AutoFilter
ActiveWindow.FreezePanes = True
xTWB.Save
Sheets("xStrAWBName").Select
Sheets("xStrAWBName").Move
ActiveWorkbook.SaveAs FileName:=FolderPath & FN2 & "-" & "ResultsSTACK", FileFormat:=xlCSV, CreateBackup:=False

Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
MsgBox "ResultsS MERGED for " & FN2 & vbLf & vbLf _
& "YOU CAN NOW USE THE FILTER HANDLES TO KNOCK OUT UNWANTED SITES OR GIGO!", vbInformation
End Sub
'==========================================================================================================
Function CountFilesInFolder(strDir As String, Optional strType As String) As Long
    Dim file As Variant, i As Integer, T As Integer
    If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
    file = Dir(strDir & strType)
    While (file <> "")
        i = i + 1
        file = Dir
    Wend
    CountFilesInFolder = i
End Function

 

[Radoslaw Poprawski]

@KasangoJS

if you want to stack (append) multiple tables why do VBA while PQ is faster and simpler?

 

[jskasango]

@KasangoJS

if you want to stack (append) multiple tables why do VBA while PQ is faster and simpler?

Does Power Query record a code that can be inserted into a Module?

 

[Radoslaw Poprawski]

yes, either you learn it trying to type that in (that's insane)
or simply record everything you do in Pq via macro recorder and use that recording in ur VBA.

 

[maabadi]

You can add this code at the part of code you show:

For N = Lr To 4 Step -1
Select Case DestSheet.Range("C" & N).Value
Case "", Is < 1
DestSheet.Rows(N).Delete
End Select
If IsNumeric(DestSheet.Range("C" & N).Value) = False Then DestSheet.Rows(N).Delete
Next N

 

[JackDanIce]

Try adding:

Dim v As Variant
Dim x As Long
x = Range("EA" & Rows.Count).End(xlUp).Row
v = Range("EA2:EA" & x).Value
For x = LBound(v, 1) To UBound(v, 1)
    If Len(v(x, 1)) = 0 Or v(x, 1) < 1 Or Not (IsNumeric(v(x, 1))) Then v(x, 1) = Null
Next x
With Range("EA2:EA" & UBound(v, 1))
    .Value = v
    .SpecialCells(xlBlanks).EntireRow.Delete
End With

Agree with @Radoslaw Poprawski recommendation of using Power Query over VBA, you can find links and videos online to familiarise yourself with it

 

[jskasango]

You can add this code at the part of code you show:

For N = Lr To 4 Step -1
Select Case DestSheet.Range("C" & N).Value
Case "", Is < 1
DestSheet.Rows(N).Delete
End Select
If IsNumeric(DestSheet.Range("C" & N).Value) = False Then DestSheet.Rows(N).Delete
Next N

It returns "Data type mismatch" .

 

[maabadi]

Try this:

For N = Lr To 4 Step -1
If IsNumeric(DestSheet.Range("C" & N).Value) = False Then 
DestSheet.Rows(N).Delete
Else
Select Case DestSheet.Range("C" & N).Value
Case "", Is < 1
DestSheet.Rows(N).Delete
End Select
End if
Next N