Array code ?
 

I am inability to adopt and modify codes in other threads as they are too
difficult for me to understand. Similar thread was posted before but now
requires a solution to accomplish more complex issue.
Sht 1
Col B = Date, Col D = amount, Col E = text (10 different text), Col F = text
(17 different text)
Select data base on
If(And(OR(Col B=Today(),if(weekday(Today)=Sat,Col B=Today()+3,Col
B=Today()+1),OR(Col E =€�A€�,Col E=€�B€�)),copy Col D and its comment,nothing)
Results will be paste to Sht 2.
The comments were generated by following code (content of comment = Col E)
Dim tst As String
tst = ActiveCell.Offset(0, 1).Value
ActiveCell.NoteText tst
Sht 2
Row 28 is a heading row from Col A to Q, when cutting first left 4
characters from them like =RIGHT(A28,LEN(A28)-4), they will be same as Sht 1
Col F

The paste destination on finding result is depends on the match of Sht 1 Col
F and Sht 2 heading.
Rgds

Array code ?
 

See if this helps. I don't know whqt the reference to Row 28 means.
Modify code as required.


Sub filterData()

NewRow = 1
With Sheets("Sheet1")
LastRow = Range("B" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
ColE = .Range("E" & RowCount)
If ColE = "€�A€�" Or ColE = "€�B€�" Then

MyDate = .Range("B" & RowCount)
If Weekday(Date) = vbSaturday Then
If MyDate = Date And MyDate <= (Date + 3) Then
CopyData = True
Else
CopyData = False
End If
Else
If MyDate = Date And MyDate <= (Date + 1) Then
CopyData = True
Else
CopyData = False
End If
End If

If CopyData = True Then
.Range("D" & RowCount).Copy _
Destination:=Sheets("Sheet2").Range("A" & NewRow)
NewRow = NewRow + 1
End If
End If
Next RowCount
End With

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=149840