Excel Find and Replace Problem with Array

[Steven Lee]

Hi,

I'm trying to write a small utility to convert names of days and months from
English to another language.

I have a form with four multi-line text boxes (FromMonth, FromDay, ToMonth,
ToDay), a "Translate" button and a "Cancel" button.

The English months & days are populated in the From textboxes and I want to
be able to paste the equivalent list of names in the other languages in the
to boxes, convert the text in the boxes to arrays, then loop through the
arrays and replace "January" with "Janvier" and "Monday" with "Lundi", etc.

When I run the code below, the first time through the arrays I get the
results I expect, but the remainder of each array never seems to process. I
step through the code and all looks good. If I manually run the Find/Replace
all is OK (February, March, April... are all found and replaced.)

Is there an Excel equivalent to word's Selection.HomeKey wdStory that I need
to invoke, or is there something wrong with my code?

Thanks so much for your help!



Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdTrans_Click()

Me.frMonths.Text = Replace(Me.frMonths.Text, Chr(13) & Chr(13), "")

Me.toMonths.Text = Replace(Me.toMonths.Text, vbCrLf, Chr(13))
Me.toMonths.Text = Replace(Me.toMonths.Text, Chr(13), Chr(13))

Me.toMonths.Text = Me.toMonths.Text & Chr(13)

Me.frDays.Text = Replace(Me.frDays.Text, Chr(13) & Chr(13), Chr(13))

Me.toDays.Text = Replace(Me.toDays.Text, vbCrLf, Chr(13))
Me.toDays.Text = Replace(Me.toDays.Text, Chr(13), Chr(13))

Me.toDays.Text = Me.toDays.Text & Chr(13)

Me.Hide

frMonthArray = Split(Me.frMonths.Text, Chr(13))
frDayArray = Split(Me.frDays.Text, Chr(13))

toMonthArray = Split(Me.toMonths.Text, Chr(13))
toDayArray = Split(Me.toDays.Text, Chr(13))

If UBound(frMonthArray) <> UBound(toMonthArray) Then
MsgBox "From and to months don't have equal number of elements"
'Exit Sub
End If

If UBound(frDayArray) <> UBound(toDayArray) Then
MsgBox "From and to days don't have equal number of elements"
Exit Sub
End If

'THIS WORKS 1st TIME THROUGH, BUT THE REST OF THE ARRAY DOES NOT FIND/REPLACE

For i = 0 To UBound(frMonthArray)
If frMonthArray(i) = "" Or frMonthArray(i) = vbCr Then GoTo
skipmonth
ActiveSheet.Cells.Replace What:=frMonthArray(i),
Replacement:=toMonthArray(i), LookAt:=xlPart, SearchOrder:=xlByRows,
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
skipmonth:
Next i

For i = 0 To UBound(frDayArray)
Range("A1").Select
If frDayArray(i) = "" Or frDayArray(i) = vbCr Then GoTo skipday
ActiveSheet.Cells.Replace What:=frDayArray(i),
Replacement:=toDayArray(i), LookAt:=xlPart, SearchOrder:=xlByRows,
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
skipday:
Next i
' Unload Me

End Sub

Private Sub UserForm_Activate()
Dim EngMonthsArr(11)
EngMonthsArr(0) = "January"
EngMonthsArr(1) = "February"
EngMonthsArr(2) = "March"
EngMonthsArr(3) = "April"
EngMonthsArr(4) = "May"
EngMonthsArr(5) = "June"
EngMonthsArr(6) = "July"
EngMonthsArr(7) = "August"
EngMonthsArr(8) = "September"
EngMonthsArr(9) = "October"
EngMonthsArr(10) = "November"
EngMonthsArr(11) = "December"

Dim EngDaysArr(6)
EngDaysArr(0) = "Monday"
EngDaysArr(1) = "Tuesday"
EngDaysArr(2) = "Wednesday"
EngDaysArr(3) = "Thursday"
EngDaysArr(4) = "Friday"
EngDaysArr(5) = "Saturday"
EngDaysArr(6) = "Sunday"

For i = UBound(EngMonthsArr) To 0 Step -1
Me.frMonths.Text = EngMonthsArr(i) & Chr(13) & Me.frMonths.Text
Next i

For i = UBound(EngDaysArr) To 0 Step -1
Me.frDays.Text = EngDaysArr(i) & Chr(13) & Me.frDays.Text
Next i

End Sub

 

[Dave Peterson]

This line:

ActiveSheet.Cells.Replace What:=frMonthArray(i), _
Replacement:=toMonthArray(i), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False

Works against all the cells in the active worksheet--so it's fine.

In my simple tests, the code that was supposed to clean up the vbcrlf, vblf,
vbcr didn't clean up all those characters--so the second time the cells.replace
line was invoked, it was looking for a string that wasn't there.

You could spend more time cleaning the strings, but how about an alternative
suggestion.

Create a worksheet with just the names (month names and day names) in it.

In column A, you'd have the English spelling.
In column B, you could have the French spelling.
In column C, you could have the Italian spelling.
And so forth.

Then instead of using a text box, you could just add a dropdown that asks what
language the english spelling should be changed to.

Then you could loop through the cells in column A of the sheet and do
Edit|replace (in code) based on the translation chosen.

I created a worksheet named "translatorkey" and put this in it:

English Spanish Italian French German Polish
$A$2 $B$2 $C$2 $D$2 $E$2 $F$2
$A$3 $B$3 $C$3 $D$3 $E$3 $F$3
$A$4 $B$4 $C$4 $D$4 $E$4 $F$4
$A$5 $B$5 $C$5 $D$5 $E$5 $F$5
$A$6 $B$6 $C$6 $D$6 $E$6 $F$6
$A$7 $B$7 $C$7 $D$7 $E$7 $F$7
$A$8 $B$8 $C$8 $D$8 $E$8 $F$8
$A$9 $B$9 $C$9 $D$9 $E$9 $F$9
$A$10 $B$10 $C$10 $D$10 $E$10 $F$10
$A$11 $B$11 $C$11 $D$11 $E$11 $F$11
$A$12 $B$12 $C$12 $D$12 $E$12 $F$12

(This was test data. You'd put all 12 months and 7 days in each column.)

Then I built a small user form--two buttons and a combobox.

Option Explicit
Private Sub CommandButton2_Click()

Dim WhichCol As Long
Dim myCell As Range
Dim myRng As Range

If Me.ComboBox1.ListIndex < 0 Then
Beep
Else
With Worksheets("translationkey")
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With
WhichCol = Me.ComboBox1.ListIndex + 1
For Each myCell In myRng.Cells
ActiveSheet.Cells.Replace What:=myCell.Value, _
Replacement:=myCell.Offset(0, WhichCol).Value, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Next myCell
End If

Unload Me

End Sub
Private Sub UserForm_Initialize()
Dim iCol As Long
With Worksheets("TranslationKey")
For iCol = 2 To .Cells(1, .Columns.Count).End(xlToLeft).Column
Me.ComboBox1.AddItem .Cells(1, iCol).Value
Next iCol
End With
End Sub