Check through Column A for matched data - copy text from column F

redspanna · May 24th 2015

Hi all

I have posted something similar before but would like help with this too please....

I would really like some help with code that will carry out the following...

Look through column A of Data sheet for a row where a date is held that equals to TODAY's date - this date will be part of a text string like..

Sunday, 23rd May, 2015 - 3 Jobs for the day

Below each row with a date text string like the above will be several rows of data like the following also through column A….
06:15 AMLoc: HOLD
06:50 AMLoc: HOLD
07:00 AMLoc: 3:TBD
11:15 AMLoc: 3:TBD
07:00 AMLoc: 2:TBD
11:15 AMLoc: 5:TBD

So if a match for Today’s date is found AND any of the rows below ALSO contain part of the text string that is equal to either Loc:3 or Loc:HOLD then copy the job # ( from Column F ) into next available row in Column I and the names below into next available row in column J

Repeat this until all data through Column A has been checked

It's quite hard to explain so I have attached a sample workbook which shows a Data sheet with the raw data through Columns A:F and the required results
in columns I and J

Hope this makes sense and many thanks

MickG · May 24th 2015

Re: Check through Column A for matched data - copy text from column F

Try this:-
Results start "I1"

Code

Sub nDates()
Dim Rng As Range, nRng As Range, Dn As Range, Sp As Variant, Sp1 As Variant
Dim Dt As Date, Dy As String, Mth As String, Yr As String, c As Long
Dim R As Range, Temp As String
With Sheets("data")
    Set Rng = .Range(.Range("A5"), .Range("A" & Rows.Count).End(xlUp))
End With
For Each Dn In Rng
    If InStr(Dn.Value, "-") > 0 Then
        Sp = Split(Dn.Value, "-"): Sp1 = Split(Sp(0), ",")
        Dy = Trim(Split(Sp1(1), " ")(1)): Mth = Trim(Split(Sp1(1), " ")(2)): Yr = Trim(Sp1(UBound(Sp1)))
        Dt = Dy & " " & Mth & " " & Yr
    Else
        If Dt = Date Then
            If nRng Is Nothing Then
                Set nRng = Dn
            Else
                Set nRng = Union(nRng, Dn)
            End If
        End If
    End If
Next Dn




Set nRng = Union(nRng, nRng.Areas(nRng.Areas.Count).Offset(1))
ReDim ray(1 To nRng.Count, 1 To 2)




For Each Dn In nRng.Areas
    For Each R In Dn
        If InStr(R.Offset(, 5).Value, "Job") > 0 Then Temp = Split(R.Offset(, 5).Value, " ")(1)
            If Not InStr(R.Offset(, 5).Value, "Job") > 0 Then
                c = c + 1
                ray(c, 1) = Temp
                ray(c, 2) = R.Offset(, 5).Value
            End If
    Next R
Next Dn




With Range("I1").Resize(c, 2)
    .Value = ray
    .Columns.AutoFit
End With
End Sub

Display More

redspanna · May 24th 2015

Re: Check through Column A for matched data - copy text from column F

Hi MickG

I really have no idea how you did that but it's fantastic - thanks so much

Check through Column A for matched data - copy text from column F

Participate now!

Share