How to find value of cell above each cell

Question

I want to screen all sheets for values that starts with "D" In the sheets I formed blocks (1 column, 4 rows) with - owner - area - parcel (that is allways starting with a "D") - year of transaction (blocks of 1 column and 4 rows).

I want to make a summary in sheet "Test".

I'm able to find the parcel, but how can I get the info from the cell above?

Sub Zoek_kavels()

Dim ws As Worksheet
Dim rng As Range
Dim Area
Dim Kavel As String

rij = 1

For Each ws In ActiveWorkbook.Sheets
    Set rng = ws.UsedRange
    For Each cell In rng
        If Left(cell.Value, 1) = "D" Then             'Starts with D
            Sheets("Test").Cells(rij, 1) = cell.Value       'Kavel D..
            Cells(cell.row - 1, cell.Column).Select
            Area = ActiveCell.Value

            Sheets("Test").Cells(rij, 2) = Area             'Oppervlakte
            Sheets("Test").Cells(rij, 3) = ws.Name          'Werkblad naam
            rij = rij + 1
        End If
    Next
Next

End Sub

to get the value of 1 cell above `cell` use `cell.Offset(-1, 0).Value`, in your case it's `Sheets("Test").Cells(rij, 2).Value = cell.Offset(-1, 0).Value` — Shai Rado, Apr 17 '18 at 11:37

Vityata · Answer 1 · 2018-04-17T15:08:54.283

0

There are two important points (and two not so important) to take care of your code:

start from row 2, because you are using .row - 1. Thus, if you start at row 1, row-1 would throw an error;
try to avoid Select, ActiveCell, etc.;(How to avoid using Select in Excel VBA);
write comments in English, not in Dutch (also good idea for variable names as well, rij or kavel do not help a lot);
declare the type of your variables, e.g. dim Area as String or as Long or anything else;

Option Explicit

Sub ZoekKavels()

    Dim ws      As Worksheet
    Dim rng     As Range
    Dim Kavel   As String
    Dim rij     As Long
    Dim cell    As Range

    rij = 2 'start from the second row to avoid errors in .Row-1

    For Each ws In ActiveWorkbook.Worksheets
        Set rng = ws.UsedRange
        For Each cell In rng
            If Left(cell, 1) = "D" Then
                With Worksheets("Test")
                    .Cells(rij, 1) = cell
                    .Cells(rij, 2) = ws.Cells(cell.Row - 1, cell.Column)
                    .Cells(rij, 3) = ws.Name
                End With
                rij = rij + 1
            End If
        Next
    Next

End Sub

Or you can use .Cells(rij, 2) = cell.Offset(-1, 0) instead of Cells(cell.Row - 1, cell.Column), as proposed in the comments by @Shai Rado.

edited Apr 17 '18 at 15:08

answered Apr 17 '18 at 11:45

Vityata

42,633
8
55
100

`.Cells(rij, 2) = Cells(cell.Row - 1, cell.Column)` seriously ? not `.Cells(rij, 2).Value = cell.Offset(-1, 0).Value` ? – Shai Rado Apr 17 '18 at 11:55
@ShaiRado - I am using the code (and the idea) of the OP, trying to change as less as possible. The `Offset()` is probably a better option. – Vityata Apr 17 '18 at 11:57
.Cells(rij, 2) = cell.Offset(-1, 0).value 'Area gives an error – C.W.A. Baltus Apr 17 '18 at 12:17
@C.W.A.Baltus - have you tried to "copy+paste" the code above? – Vityata Apr 17 '18 at 12:18
Yes I copied the code but I get an error. Try it yourself buy adding a simple sheet with A2 = 400 and A3 = D1234. After executing the macro should be visible in sheet "Test" – C.W.A. Baltus Apr 17 '18 at 12:30
@C.W.A.Baltus - I have added `.Cells`, try again, putting the code in a module. – Vityata Apr 17 '18 at 13:48
@Vityata Solved! I added ws. , so “.Cells(rij, 2) = ws.Cells(cell.row - 1, cell.Column).Value” works fine. Thanks for your help. – C.W.A. Baltus Apr 17 '18 at 14:57
@C.W.A.Baltus - bravo! – Vityata Apr 17 '18 at 15:09

score 0 · Answer 2 · answered Apr 17 '18 at 13:46

A nice simple loop should do the trick, you may have had spaces in the worksheet, that would throw off the used range. Here is a different approach.

   Sub Get_CellAboveD()
    Dim LstRw As Long, sh As Worksheet, rng As Range, c As Range, ws As Worksheet, r As Long

    Set ws = Sheets("Test")

    For Each sh In Sheets
        If sh.Name <> ws.Name Then
            With sh
                LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
                Set rng = .Range("A1:A" & LstRw)
                If LstRw > 1 Then
                    For Each c In rng.Cells
                        If Left(c, 1) = "D" Then
                            r = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
                            ws.Range("A" & r).Value = c
                            ws.Range("B" & r).Value = c.Offset(-1).Value
                            ws.Range("C" & r).Value = sh.Name
                        End If
                    Next c
                End If
            End With
        End If
    Next sh
 End Sub

How to find value of cell above each cell

2 Answers2