A macro that fishes for colored cells?

[Arlen]

Hello, All! Happy weekend.

I must tally counts and sums for a year's worth of business archived as 52
workbooks that each tell one week's tale. Sounds simple, but problems abound.

Problem: The dates in the archives are not dates at all...somebody simply
typed in Sun 1/05/07, and sometimes Thur. 1/09/2007. In the same column,
there are entries like "Dr. Dale/Ernst", so the one unique characteristic of
all 'date' cells is that they have a yellow background.

Question: How do you write a macro that searches B4:B100 for yellow cells,
then converts the text inside to a real date with the ddd mm/dd/yy format?

I sure do appreciate ye.

Arlen

 

[Joel]

What I recommend is to gather all the dates in one workbook. Correct the
dates then save them back to make sure the changes are made correctly. Below
is a macro that will get the highlighted cells in column a, put the address
of the cell in column C, and put the names of the files where they came as
the worksheet name.

Run the macro. Then evaluate what need to be changed and write a macro to
change the dates by putting the corrected dates in Column b. Then write a
third macro to save the corrected dates. This will make sure that the
process is done correctly.

Put all the files in the same directory so the macros can easily find each
file. I will help as needed.

to correct the dates may be very simple. It might be that is all is
required is to remove the first word (ie thur.) and use datevalue to convert
to a real date

MyDate = "Thur. 1/09/2007"
'remove spaces at beginning and end
MyDate = trim(MyDate)
'Test if there is a blank
if Instr(MyDate," ") > 0 then
MyDate = mid(MyDate,instr(MyDate," ")+1)
end if
MyDate = DateValue(MyDate)

Here is the code to get the dates

Sub GetDates()

Folder = "c:\temp\"
FName = Dir(Folder & "*.xls")
Do While FName <> ""
Set ArchiveBk = Workbooks.Open(Filename:=Folder & FName)
Set NewSht = ThisWorkbook.Sheets.Add _
(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
NewSht.Name = FName

Set RowCount = 1
For Each cell In ArchiveBk.ActiveSheet.Range("B4:B100")
If cell.Interior.ColorIndex <> xlNone Then
With NewSht
.Range("A" & RowCount).Value = cell.Value
.Range("C" & RowCount).Value = cell.Address
RowCount = RowCount + 1
End With
End If
Next cell
ArchiveBk.Close
FName = Dir()
Loop
End Sub

 

[Arlen]

Joel,

Thank you for taking the time to help me with this. I am a VBA novice, so I
have to ask some questions, but I'm hoping you stick with me.

I put the Sub GetDates() into the Personal workbook. I made 6 dummy archive
books, Book1-6 and ran the macro, but I get a Compile Error: Object Expected
with the Set RowCount = 1 line. The one is highlighted in blue. So...what
next?

Thanks again.

Arlen