CODEWITHSUNDEEP
vbaexcelloopsexcel-formula
Anne
Anne

Reputation: 105

Fill empty cells with above values with Criteria as lookup VBA

I'm trying to copy datas from the above row since for each row has account number but a certain account number doesn't have other cells data in it's row.

update:

from this raw

User    |        Date           |          Location       |      Acct#    |
John    |       11/10/16        |          India          |      1.202027 |
        |                       |                         |      1.202024 |
Anna    |       9/8/16          |           USA           |      1.202027 |
        |                       |                         |      1.202027 |
Isaac   |        9/9/15         |           France        |      1.202024 |
        |        7/9/15         |                         |      1.202027 |

to this:

User    |        Date           |          Location       |      Acct#    |
John    |       11/10/16        |          India          |      1.202027 |
John    |       11/10/16        |          India          |      1.202024 |
Anna    |       9/8/16          |           USA           |      1.202027 |
        |                       |                         |      1.202027 |
Isaac   |        9/9/15         |           France        |      1.202024 |
        |        7/9/15         |                         |      1.202027 |

from the sample above I only need to fill the data for "Acct#" 1.202024 with the data from above it which is from the acct# 1.202027. if cells from 1.202027 is empty leave it be. I don't need to fill acct# 1.202027

Notice that it only populates cells under the row with account number 1.202024 with values coming from 1.202027 above it. if 1.202024 has a value already just like the second 1.202024 in the raw file, then we'll leave it be. if the 1.202027 account number doesn't have any values do nothing even there is a 1.202024 below it.

this is the code I'd come yet

 Sub Fillblankcells()
Dim cell As Range, r As Range, s As Range
    For Each r In Range("N2", Cells(rows.Count, "N").End(xlUp))
     For Each s In Range("L2", Cells(rows.Count, "L").End(xlUp))
         If cell.Value Like "*1.202024*" Then
          s = "=R[-1]C"
        End If
    End If
    End If

Next r
End Sub

ADD: just to clear the value of range"N2:N" is where my acct number is and the range "L2:L" is just a basis if it copies. but I'm trying to copy cell values from column A:R

I'm quite stuck.Thanks! cheers!

UPDATE ! SOLVED

credits to @user3598756 . I've got it working with

Sub fillblankcells() 'fill columns with criteria
Dim cell As Range
With ActiveSheet
    With .Range("A2", .Cells(.rows.Count, "R").End(xlUp))
   .AutoFilter Field:=14, Criteria1:="1.202024"

 If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then
    For Each cell In .Resize(.rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible)

 If WorksheetFunction.Trim(cell.text) = vbNullString Then cell.Resize(, 13).Value = cell.Offset(-1).Resize(, 13).Value

 Next cell
 End If
 End With
 .AutoFilterMode = False
 End With
 End Sub

Upvotes: 0

Views: 1068

Answers (1)

user3598756
user3598756

Reputation: 29421

you could try this (commented) code:

Option Explicit

Sub main()
    Dim cell As Range
    With ThisWorkbook.Worksheets("mySheetName") '<--| reference relevant worksheet (change "mySheetName" to your actual sheet name)
        With .Range("K1", .Cells(.Rows.Count, "N").End(xlUp)) '<--| reference ts relevant range: here it's assumed columns K to N from row 1 (header) down to last column "N" not empty cell
            .AutoFilter Field:=4, Criteria1:="1.202024" '<--| filter its 4th column (i.e. column "N") with "1.202024"
            If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any cell filtered other than header
                For Each cell In .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible) '<--|loop through filtered cells in 1st column (i.e. column "K")
                    If WorksheetFunction.Trim(cell.Text) = vbNullString Then cell.Resize(, 3).Value = cell.Offset(-1).Resize(, 3).Value '<-- if empty cell then copy from cells above
                Next cell
            End If
        End With
    .AutoFilterMode = False '<--| remove autofilter and brong rows back visible
    End With
End Sub

Upvotes: 0

Related Questions