Удалить пустые строки из выделенной области и условно заменить значение на значение в ячейке выше

Question

Мне нужно очистить извлеченные данные ERP со многих листов, чтобы я мог их проанализировать.

Пример формата данных:

   
Material MvTS   Mat. Doc.   Item    Pstng Date  Time

1091769             Air Mover Type AM20-SN      
3   *711        4903961381      25.10.2018  11:29:03

3 *711      4903961381      25.10.2018  11:29:03

1598718             Filter      
3   711     4901254258      12.04.2018  10:52:06

1652333             O-Ring FKM 37.82x1.78 Black     
3   711     4904214978      14.11.2018  09:53:54

1653970             Gasket assembly EV344D 20 PA        
3   711     4903943685      24.10.2018  13:18:48

Я хочу:

1. Используйте поле ввода для определения диапазона данных, которые необходимо очистить
2. Если Material = 3, заменить номер материала в ячейке выше
3. Если MVt == "" (Пусто), удалить строку

---

Sub CleanVendorData()

    Dim r As Range
    Dim row As Long
    Dim col As Long
    Dim adr As Range
    Dim adr1 As Range
    Dim HeadRow As Double
    Dim LowRow As Double
    Dim num As Double
    Dim i As Double
    Dim dynamic As Long

    Dim rng As Range
    Set rng = Application.InputBox("Choose a random cell in the Vendor file that you want to clean", "Clean Vendor forecast file", Type:=8)
    Workbooks(rng.Worksheet.Parent.Name).Activate

    'Deleting empty rows.
    Range("A100000").Select
    Selection.End(xlUp).Select
    Set adr1 = ActiveCell
    LowRow = adr1.row

    'finding out how bit the area of data is before its deleted:)
    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Set adr = ActiveCell
    dynamic = adr.row

    Set r = ActiveSheet.Range(Cells(dynamic, 1), Cells(LowRow + dynamic, 20))
    '"A10:s50000")
    row = r.Rows.Count
    For i = row To 1 Step (-1)
        If WorksheetFunction.CountA(r.Rows(i)) = 0 Then r.Rows(i).Delete
        If WorksheetFunction.CountA(r.Rows(i)) = 1 Then r.Rows(i).Delete
    Next

    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Set adr = ActiveCell
    HeadRow = adr.row
    Rows(HeadRow).Clear
    num = Cells(HeadRow + 1, 1).CurrentRegion.Rows.Count - 2

    Next

    MsgBox ("Done")

End Sub