macro for convert data format into another format 3

[selenus]

I need help with macro: I have Excel workbook containing spreadsheets with data format as follows:

2003.gada "08" Janvaris
2003.gada 12. Februaris
2003.gada "25." marta
2003.gada "22." aprilis
2003.gada "12." maijs
2003.gada "15." junijs
2003.gada 08. Julijs
2003.gada 05. Augusts
2003.gada "02." septembris
2003.gada "06." Oktobris
2003.gada "04." Novembris
2003.gada "01" Decembris

I need macro that will sequencely scan spreadsheets for this data, extract data, and store it into separate spreadsheet into following format: dd-mm-yyyy (as list).
example:
2003.gada "08" Janvaris --> need get: 08-01-2003


By default, data stored in F5 cell, but here is one small problem: some spreadsheets formatting may differ a little, i.e. cells with data may be differ(float from E5 to G5), for vertical also, for F4 - F6. Some Month name may differs in syntax a little also, commas may missing.

 

[ETID]

What version of office / Excel are you using?

 

[ETID]

by the error you decribe...I suspect 2000 or earlier

 

[byundt]

The older version of Excel doesn't have the Replace function in VBA, but you can use the worksheet SUBSTITUTE function instead. This modification to the sub works with your sample data in Excel 97:

Sub DateConversion()
Dim cel As Range
Dim RgExp As Object
Dim temp As Variant
Dim str As String
Dim i As Long
Set RgExp = CreateObject("VBScript.RegExp")
RgExp.Pattern = "(\d{4})\.\s?gada\s*\x22?(\d{2})[\.|\s]?\x22?\s*(.{3}).*"
On Error Resume Next
For Each cel In Range(Cells(2, 5), Cells(65536, 5).End(xlUp))
    If Not IsError(cel) Then
        If cel <> "" And RgExp.test(LCase(cel.Value)) Then
            str = RgExp.Replace(LCase(cel), "$2 $3 $1")
            str = Application.Substitute(str, "okt", "oct")    'Fix October
            str = Application.Substitute(str, ChrW(363), "u")  'Fix June, July
            str = Application.Substitute(str, "mai", "may")    'Fix May
            str = Application.Substitute(str, "maj", "may")    'Fix May misspelling
            temp = DateValue(str)
            i = i + 1
            If Err > 0 Then
                cel = str
                Err.Clear
            Else
                cel = temp
            End If
        End If
    End If
Next cel
Range(Cells(2, 5), Cells(65536, 5).End(xlUp)).NumberFormat = "dd-mm-yyyy"
End Sub

Brad

 

[selenus]

I use MS Excel-2000, eng. For more clearness, I'v put a sample of the data on a site:

http://fire.prohosting.com/pulsed/data-list.zip

Selenus

 

[ETID]

I will post revisions for the "search" lines in the code.

Selection.Replace What:=mon_text(m), Replacement:=mon_val(m), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

I beleive they hould be compatible with excel 2000.

I don't have office 2000 available at the moment, so give me a day

 

[ETID]

'replace with this syntax...



For m = 0 To 11
ActiveCell.Replace What:=mon_text(m), Replacement:=mon_val(m), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Next m
clutter = Array(".", "gada", Chr$(34), " ")
For j = 0 To 3
ActiveCell.Replace What:=clutter(j), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Next j

 

[selenus]

I tried, but got the follows(for all date)

ad-.g-2003
ad-.g-2003
ad-.g-2003

Of course, it very difficult thing, bescause my date written unpunctual a little, 'float', missing commas, etc.

PHV was very close to success, his code worked, but not fully correct: some the date were not converted. I think, that if it can correct the code it it would OK
I would place converted date into separate column 'F', I inserted additional column for this.

Selenus