if exists find last values in variable rows

**ABBOV** · 09-02-2010, 07:57 AM

Hello,

I'm new to VBA, managed to convert some script to my one but I need some help with the following:

There an input sheet called " Invoer", this sheet shows all the sales of an department. I would like to make a summary of all the names en their sales. The problem is that the totals of every name are in different rows and columns.

Example:
Name 1 finds it totals at 3 rows down and 5 colums left.
name 2 finds it totals at 5 rows down and 4 columns left.
Name 3 finds it totals at 3 rows down and 7 coloms left.

I know how to use the find function but not when it's so variable.

I included the an example (with an extra problem ;-))

Thanks in advance

ABBOV

**StephenR** · 09-02-2010, 08:09 AM

So the relevant total is always the intersection between "Conversie" and "Totaal" (plus the number underneath)?

**MarvinP** · 09-02-2010, 09:02 AM

In your code try:

InvoerBlad.Range("B1:B" & ActiveSheet.UsedRange.Rows.count)
'instead of
With InvoerBlad.Range("B1:B1000")

**ABBOV** · 09-02-2010, 12:47 PM

Originally Posted by StephenR

So the relevant total is always the intersection between "Conversie" and "Totaal" (plus the number underneath)?

Stephen,

Thats correct, that are the 2 values that has to be summarised with the name above.

**ABBOV** · 09-02-2010, 12:48 PM

Originally Posted by MarvinP

In your code try:

InvoerBlad.Range("B1:B" & ActiveSheet.UsedRange.Rows.count)
'instead of
With InvoerBlad.Range("B1:B1000")

Marvin,

What's the difference?

**MarvinP** · 09-02-2010, 03:38 PM

Hi ABBOV,

Your title said "variable row".
When you code with Range("B1:B1000") this is fixed and does not change.

If you code with Range("B1:B" & ActiveSheet.UsedRange.Rows.count)
the number of rows varies based on the value after the "&".

I was seeing if this syntax might help you.

**ABBOV** · 09-02-2010, 04:56 PM

Originally Posted by MarvinP

Hi ABBOV,

Your title said "variable row".
When you code with Range("B1:B1000") this is fixed and does not change.

If you code with Range("B1:B" & ActiveSheet.UsedRange.Rows.count)
the number of rows varies based on the value after the "&".

I was seeing if this syntax might help you.

Marvin,

Thanks, your right, it's not the complete answer to my problem but it helps me understand vba.

Best Regards,

ABBOV

**ABBOV** · 09-03-2010, 04:26 AM

Hello,

I think I found the right formula: (starting from the first found name.)

=INDEX(R[1]C[-1]:R[15]C[10],MATCH(""Conversie"",R[1]C[-1]:R[15]C[-11],),MATCH(""Totaal"",R[1]C[-1]:R[1]C[15]))"

Now it has to be fitted in. But i have got no clues.

Best Regards.

ABBOV

**StephenR** · 09-03-2010, 06:25 AM

Try this.

Sub zoek_gebuiker()

Dim c As Range, firstaddress As String, c1 As Range, c2 As Range, v

Application.ScreenUpdating = False

With Blad1.Range("B1", Blad1.Range("B" & Rows.Count).End(xlUp))
    Set c = .Find(What:="Medewerker:", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
            c.Offset(0, 1).Copy
            uitvoerBlad.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Set c1 = .Find(What:="Conversie", After:=c, Lookat:=xlWhole, SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            Set c2 = Blad1.Cells.Find(What:="Totaal", After:=c, Lookat:=xlWhole, SearchOrder:=xlByRows, _
                                           SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If Not c1 Is Nothing And Not c2 Is Nothing Then
                Blad1.Cells(c1.Row, c2.Column).Copy
                uitvoerBlad.Range("E" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
                Blad1.Cells(c1.Row + 1, c2.Column).Copy
                uitvoerBlad.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            End If
            v = Application.Match(c.Offset(, 1), uitvoerBlad.Columns("K:K"), 0)
            If IsNumeric(v) Then
                uitvoerBlad.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value = Application.Index(uitvoerBlad.Columns("L:L"), v, 1)
            End If
            Set c = .Find(What:="Medewerker:", After:=c1, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
        Loop While c.Address <> firstaddress
        
    End If
End With

Application.ScreenUpdating = True

End Sub

**snb** · 09-03-2010, 08:11 AM

or

Sub snb()
  On Error Resume Next
  With Sheets("Invoer").UsedRange
    For j = 1 To 2
      With .Columns(Choose(j, 1, 3))
        jj = 1
        .AutoFilter 1, Choose(j, "Medewerker*", "Totaal*")
        For Each cl In .Offset(1).SpecialCells(xlCellTypeVisible)
          If jj + j = 2 Then sq = Cells(1, 20).Resize(.Offset(1).SpecialCells(12).Count, 4)
          If j = 1 Then
            sq(jj, 1) = cl.Offset(, 1)
            sq(jj, 2) = Sheets("Conversie Tool").Columns(11).Find(sq(jj, 1), , xlValues, xlWhole).Offset(, 1).Value
          Else
            sq(jj, 3) = cl.End(xlToRight).Offset(-1)
            sq(jj, 4) = cl.End(xlToRight)
          End If
          jj = jj + 1
        Next
        .AutoFilter
      End With
    Next
  End With
  Sheets("Conversie Tool").Cells(5, 3).Resize(UBound(sq), UBound(sq, 2)) = sq
End Sub

**ABBOV** · 09-03-2010, 09:33 AM

Stephen,

Thanks, the code works and I'm almost there, only i found a small bug.

When the value of "c" is not found in "Uitvoerblad row K". nothing is copied to row D.
If the next value of "c" is found the associated aspectcode is copied to row D, only it's copied to the first free row. not the the row that is associated with the name (in value "c")

Because I don't need the names if there not in in row K (on "uitvoerblad"), maybe it's possible to ignore the values that are not found. I tried to do it myself by moving the "value v" part to the top but that results in different errors.

Do you have got any ideas?

Thanks in advance.

ABBOV

**ABBOV** · 09-03-2010, 09:55 AM

Originally Posted by snb

or

Sub snb()
  On Error Resume Next
  With Sheets("Invoer").UsedRange
    For j = 1 To 2
      With .Columns(Choose(j, 1, 3))
        jj = 1
        .AutoFilter 1, Choose(j, "Medewerker*", "Totaal*")
        For Each cl In .Offset(1).SpecialCells(xlCellTypeVisible)
          If jj + j = 2 Then sq = Cells(1, 20).Resize(.Offset(1).SpecialCells(12).Count, 4)
          If j = 1 Then
            sq(jj, 1) = cl.Offset(, 1)
            sq(jj, 2) = Sheets("Conversie Tool").Columns(11).Find(sq(jj, 1), , xlValues, xlWhole).Offset(, 1).Value
          Else
            sq(jj, 3) = cl.End(xlToRight).Offset(-1)
            sq(jj, 4) = cl.End(xlToRight)
          End If
          jj = jj + 1
        Next
        .AutoFilter
      End With
    Next
  End With
  Sheets("Conversie Tool").Cells(5, 3).Resize(UBound(sq), UBound(sq, 2)) = sq
End Sub

SNB,

Thanks, it realy shortens the code (and now i really don't understand it)
Sadly it does not give the desired effect, the wrong percentage is copied, now it copies the first percentage in column "conversie", not the total percentage. (last value in column "conversie").

However, you managed to solve the problem with the incorrect "associated aspect nr's" (see my reply to Stephen earlier)

Thanks

ABBOV

**StephenR** · 09-03-2010, 10:11 AM

Try this. It would probably have been simpler just to loop through the names on the first sheet if you're not interested in any others.

Sub zoek_gebuiker()

Dim c As Range, firstaddress As String, c1 As Range, c2 As Range, v, n As Long

Application.ScreenUpdating = False

With Blad1.Range("B1", Blad1.Range("B" & Rows.Count).End(xlUp))
    Set c = .Find(What:="Medewerker:", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
            n = uitvoerBlad.Range("C" & Rows.Count).End(xlUp).Row + 1
            v = Application.Match(c.Offset(, 1), uitvoerBlad.Columns("K:K"), 0)
            If IsNumeric(v) Then
                uitvoerBlad.Range("D" & n).Value = Application.Index(uitvoerBlad.Columns("L:L"), v, 1)
                c.Offset(0, 1).Copy
                uitvoerBlad.Range("C" & n).PasteSpecial xlPasteValues
                Set c1 = .Find(What:="Conversie", After:=c, Lookat:=xlWhole, _
                               SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                               MatchCase:=False, SearchFormat:=False)
                Set c2 = Blad1.Cells.Find(What:="Totaal", After:=c, Lookat:=xlWhole, _
                                          SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                          MatchCase:=False, SearchFormat:=False)
                If Not c1 Is Nothing And Not c2 Is Nothing Then
                    Blad1.Cells(c1.Row, c2.Column).Copy
                    uitvoerBlad.Range("E" & n).PasteSpecial xlPasteValuesAndNumberFormats
                    Blad1.Cells(c1.Row + 1, c2.Column).Copy
                    uitvoerBlad.Range("F" & n).PasteSpecial xlPasteValuesAndNumberFormats
                End If
            End If
            Set c = .Find(What:="Medewerker:", After:=c, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
        Loop While c.Address <> firstaddress
    End If
End With

Application.ScreenUpdating = True

End Sub

**ABBOV** · 09-03-2010, 10:48 AM

Stephen,

That does the trick, thank you very much for helping. Now i'm gonna study on the code to learn it myself.

Best Regards.

ABBOV
Arjan B. Busger op Vollenbroek

**snb** · 09-03-2010, 11:03 AM

I think you'd better clean up the 'invoer'sheet :
delete column A
remove spaces in columns after the last numerical data.

It's even simpler with:

Sub snb()
  On Error Resume Next
  With ThisWorkbook.Sheets("Invoer").UsedRange
      With .Columns(1)
        jj = 1
        .AutoFilter 1, "Medewerker*", xlOr, "Conversie"
        For Each cl In .Offset(1).SpecialCells(xlCellTypeVisible)
            If Left(cl.Value, 1) = "M" Then
              If jj = 1 Then sq = Cells(1, 20).Resize(.Offset(1).SpecialCells(12).Count \ 2, 4)
              sq(jj, 1) = cl.Offset(, 1)
              sq(jj, 2) = ThisWorkbook.Sheets("Conversie Tool").Columns(11).Find(sq(jj, 1), , xlValues, xlWhole).Offset(, 1).Value
            Else
              sq(jj, 3) = cl.Offset(, 40).End(xlToLeft)
              sq(jj, 4) = cl.Offset(, 40).End(xlToLeft).Offset(1)
              jj = jj + 1
            End If
        Next
        .AutoFilter
      End With
  End With
  ThisWorkbook.Sheets("Conversie Tool").Cells(5, 3).Resize(UBound(sq), UBound(sq, 2)) = sq
End Sub

Thread: if exists find last values in variable rows

Thread Tools

Display

if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Re: if exists find last values in variable rows

Thread Information

Users Browsing this Thread

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions