Delete Blank Lines - excel

Question

I need to have this code look from the bottom up and once it reaches a cell in Column G that is populated it stops deleting lines. Can some one help me out. There will be blanks in column G but, I just need it to look from the bottom up to the last populated cell in column G and delete everything below that.
Routine to Delete Blank Lines to the Datasheet, Uncertainty and Repeatability Sheets
Public Sub DeleteBlankLines()
' Declaring the variables
Dim WS As Worksheet
Dim UncWs As Worksheet, RepWs As Worksheet, ImpWs As Worksheet
Dim StopAtData As Boolean
Dim UserAnswer As Variant
Dim rngDelete As Range, UncDelete As Range, RepDelete As Range, ImpDelete As Range
Dim RowDeleteCount As Integer
'Set Worksheets
Set UncWs = ThisWorkbook.Sheets("Uncertainty")
Set RepWs = ThisWorkbook.Sheets("Repeatability")
Set WS = ThisWorkbook.Sheets("Datasheet")
Set ImpWs = ThisWorkbook.Sheets("Import Map")
'Set Delete Variables to Nothing
Set rngDelete = Nothing
Set UncDelete = Nothing
Set RepDelete = Nothing
Set ImpDelete = Nothing
RowDeleteCount = 0
'Determine which cells to delete
UserAnswer = MsgBox("Do you want to delete empty rows " & _
"outside of your data?" & vbNewLine, vbYesNoCancel)
If UserAnswer = vbYes Then
StopAtData = True
'Not needed Turn off at Call in Form
'Application.Calculation = xlCalculationManual
'Application.ScreenUpdating = False
'Application.EnableEvents = False
' Set Range
DS_LastRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
For CurrentRow = DS_StartRow To DS_LastRow Step 1
' Delete blank rows by checking the value of cell in column G (Nominal Value)
With WS.Range("G" & CurrentRow & ":O" & CurrentRow)
If WorksheetFunction.CountBlank(.Cells) >= 9 Then
If rngDelete Is Nothing Then
Set rngDelete = WS.Rows(CurrentRow)
Set UncDelete = UncWs.Rows(CurrentRow)
Set RepDelete = RepWs.Rows(CurrentRow)
Set ImpDelete = ImpWs.Rows(CurrentRow)
RowDeleteCount = 1
Else
Set rngDelete = Union(rngDelete, WS.Rows(CurrentRow))
Set UncDelete = Union(UncDelete, UncWs.Rows(CurrentRow))
Set RepDelete = Union(RepDelete, RepWs.Rows(CurrentRow))
Set ImpDelete = Union(ImpDelete, ImpWs.Rows(CurrentRow))
RowDeleteCount = RowDeleteCount + 1
End If
End If
End With
Next CurrentRow
Else
Exit Sub
End If
'Refresh UsedRange (if necessary)
If RowDeleteCount > 0 Then
UserAnswer = MsgBox("This will Delete " & RowDeleteCount & " rows, Do you want to delete empty rows?" & vbNewLine, vbYesNoCancel)
If UserAnswer = vbYes Then
' Delete blank rows
If Not rngDelete Is Nothing Then
UncWs.Unprotect ("$1mco")
RepWs.Unprotect ("$1mco")
rngDelete.EntireRow.Delete Shift:=xlUp
UncDelete.EntireRow.Delete Shift:=xlUp
RepDelete.EntireRow.Delete Shift:=xlUp
ImpDelete.EntireRow.Delete Shift:=xlUp
UncWs.Protect "$1mco", , , , , True, True
RepWs.Protect ("$1mco")
End If
Else
MsgBox "No Rows will be Deleted.", vbInformation, "No Rows Deleted"
End If
Else
MsgBox "No blank rows were found!", vbInformation, "No Blanks Found"
End If
' Set New Last Row Moved to Event
DS_LastRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
'Update Line Count on Datasheet
WS.Range("A9").Value = DS_LastRow - DS_StartRow + 1
'Not needed Turn on at Call in Form
'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
'Application.EnableEvents = True
End Sub

Answer 1

Delete Below Last Row
Instead of Delete you can use Clear, or if you want to preserve the formatting below the last row, you can use ClearContents.
The Code
Option Explicit
Sub DelRows()
Const cSheet As Variant = "Sheet1" ' Worksheet Name/Index
Const cColumn As Variant = "G" ' Cirteria Column Letter/Number
Dim lastR As Long ' Last Row
With ThisWorkbook.Worksheets(cSheet)
lastR = .Cells(.Rows.Count, cColumn).End(xlUp).Row
.Range(.Cells(lastR + 1, 1), .Cells(.Rows.Count, 1)).EntireRow.Delete
End With
End Sub