vba help

D

dulitul

New member
Joined
Dec 13, 2012
Messages
16
Reaction score
0
Points
0
Hey folks,

I ve got difficulty for sorting some info in excel.


I want the following: in column B:B for each word "upload" then I want to copy the corresponding date from columns K-M in a different column from the sheet say column P. I want to do the same, but for the word "ebucht" from column N from the table. For each ebucht (which means booked) I want to paste the corresponding date in the column Q (next to column P) and put it next to every "upload" date. I want then to substract the the dates so I can detect any changes. I ve done this manually in excel with the if-formula to extract the dates and then datediff to see their difference.

I have to do this for each workitem (Column A). However, the problem is that for some workitems there is not erbucht (finished) word in column N, since they are not yet finished. In those cases I want to have those workitems colored in red. And that's exactly the thing I cannot automate. I dont know how to differentiate if there is the word ebucht for each workitem, since the rows of development might be different for each workitem.

I hope you understood me. Pls help
 

Attachments

  • data sample.xls
    63 KB · Views: 14
dulitul, try this...

Code: 
Option Explicit
Sub ExtractDates()
    Dim i As Long
    Dim LastRow As Long
    Dim lRow As Long
    Dim rng As Range
    Dim c As Variant
    Dim ebucht As Boolean
    
    LastRow = ActiveWorkbook.ActiveSheet.Cells(65000, 14).End(xlUp).Row
    Set rng = ActiveWorkbook.ActiveSheet.Range("A2:A" & LastRow)
    
    lRow = 2
    For Each c In rng
        If Len("" & c.Value) = 0 Then
            If IsEmpty(Range(Cells(c.Row, 1), Cells(c.Row, 14))) = False Then
                If Cells(c.Row, 2) = "Upload" Then
                    Cells(lRow, 16).Value = Cells(c.Row, 11).Value
                Else
                    If Cells(c.Row, 14).Value = "ebucht" Then
                        Cells(lRow, 17).Value = Cells(c.Row, 11).Value
                        ebucht = True
                    End If
                End If
            Else: Exit For
            End If
        Else
            If c.Row > 2 Then
                If ebucht = False Then
                    Range(Cells(lRow, 1), Cells(lRow, 14)).Interior.Color = 255
                End If
            End If
            lRow = c.Row
            ebucht = False
        End If
    Next c
End Sub
 
Why don't you use conditional formatting?
 
You must log in or register to reply here.
Back
Top