I have workbooks for each month. They all contain columns with date, tramline number and a delay reason. To specify the delay reason the row with the entry is colorcoded red or green.To search for specific tramline number and date across the workbooks i used the code below. It's perfect. But the result however comes back in a new sheet without the color code.
I tried to change the application.transpose command and had a look at the ws.cells.find command together with a IT pro from my company. But no one knows VBA.
Please help.
Thanks
the code I found which works perfectly without copying the color:
http://www.ozgrid.com/forum/showthread.php?t=162900
Code
Sub test()
Dim myDir As String, fn As String, ws As Worksheet, r As Range
Dim a(), n As Long, x As Long, myTask As String, ff As String, temp
myDir = "c:\test\" '<- change here
If Dir(myDir, 16) = "" Then
MsgBox "No such foloder path", 64, myDir
Exit Sub
End If
myTask = InputBox("Enter Task number")
If myTask = "" Then Exit Sub
x = Columns.Count
fn = Dir(myDir & "*.xls*")
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Do While fn <> ""
With Workbooks.Open(myDir & fn, 0)
For Each ws In .Worksheets
Set r = ws.Cells.Find(myTask, , , 1)
If Not r Is Nothing Then
ff = r.Address
Do
n = n + 1
temp = r.EntireRow.Value
Redim Preserve temp(1 To 1, 1 To x)
Redim Preserve a(1 To n)
a(n) = temp
Set r = ws.Cells.FindNext(r)
Loop While ff <> r.Address
End If
Next
.Close False
End With
fn = Dir
Loop
With ThisWorkbook.Sheets(1).Rows(1)
.CurrentRegion.ClearContents
If n > 0 Then
.Resize(n).Value = _
Application.Transpose(Application.Transpose(a))
Else
MsgBox "Not found", , myTask
End If
End With