1

I´m trying to set a array with data from a MS Excel range. My VBA Macro replaces the text from an array with text from another array. It works fine with arrays, but now I´m trying to fill these arrays with data from a Excel file. I´m using range and I´ve tried thousands of ways of making itwork, unsuccessfuly. I´m not a VBA coder, so maybe I´m missing some basic concepts.... :|

Heres the code. Thanks in advance for any help!

Sub ReplacePT2ES()

    Dim oSld As Slide
    Dim oShp As Shape
    Dim oTxtRng As TextRange
    Dim oTmpRng As TextRange
    Dim strWhatReplace As String, strReplaceText As String
    Dim x As Long


    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim rng As range


    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("D:\DOCS\DiccionarioPT2ES.xlsx")
    xlBook.Application.Visible = False
    xlBook.Application.WindowState = xlMinimized


    Dim findList As Variant
    Dim replaceList As Variant

    Set findList = range("A1:A3").Value

    Set replaceList = range("B1:B3").Value
    '-- works fine with array
    'findList = Array("falha", "lei", "projeto", "falhas", "leis", "projetos", "falham", "os", "as", "gestor")
    'replaceList = Array("falla", "ley", "proyecto", "fallas", "leyes", "proyectos", "fallan", "los", "las", "gerente")

    'MsgBox "Iniciando!"

    For x = findList.Count To replaceList.Count
        ' go during each slides
        For Each oSld In ActivePresentation.Slides
             ' go during each shapes and textRanges
            For Each oShp In oSld.Shapes
                 ' replace in TextFrame
                'If oShp.HasTextFrame And UBound(findList) And UBound(replaceList) > 0 Then
                 If oShp.HasTextFrame Then

                    Set oTxtRng = oShp.TextFrame.TextRange
                    Set oTmpRng = oTxtRng.Replace(FindWhat:=findList(x), Replacewhat:=replaceList(x), WholeWords:=True)

                    Do While Not oTmpRng Is Nothing

                        Set oTxtRng = oTxtRng.Characters(oTmpRng.Start + oTmpRng.Length, oTxtRng.Length)
                        Set oTmpRng = oTxtRng.Replace(FindWhat:=findList(x), Replacewhat:=replaceList(x), WholeWords:=True)
                    Loop
                 End If
            Next oShp
        Next oSld
    Next x

 xlBook.Close SaveChanges:=False
 Set xlApp = Nothing
 Set xlBook = Nothing
 'MsgBox "Listo!"


End Sub
3
  • If you open your locals window and step through the macro with F8, when you get to the line fa x = ... Inspect findlist and replacelist. Do they hold the values from your excel sheet like you expect them to? Commented Mar 13, 2016 at 4:18
  • add full path to the range, specify both workbook ad worksheet like wb.ws.Range("A1:A3") , where wb and ws are the variable names which you have set the wanted workbook and worksheet objects to. in your code you already have set xlBook to the wanted workbook, so you're missing two statements: the declaration of a Worksheet object variable (dim ws as Worksheet) and that variable initialization (set ws = xlBook.Worksheets("putYourActualSheetName")) Commented Mar 13, 2016 at 7:15
  • Thanks Rodger, the list actualy yes, it show the content of the excel. The problem, I think, is about the kind of variables. When it´s array it works fine, when I try to assing the values from the Range datatype, is when it doesnt work. Thats why my question, so far, is: how to put the data range values into the array. Commented Mar 13, 2016 at 11:56

2 Answers 2

1

Finaly I found a solution: stop using Array and swith to Dictionary. Here the code wich worked:

Set findList = range("A1:A10")
Dim MyDictionary As Object
Set MyDictionary = CreateObject("Scripting.Dictionary")

With MyDictionary
    For Each RefElem In findList
        If Not .Exists(RefElem) And Not IsEmpty(RefElem) Then
            .Add RefElem.Value, RefElem.Offset(0, 1).Value
        End If
    Next RefElem
End With

Moral of the history: use the right datatype for the job ;)

Sign up to request clarification or add additional context in comments.

Comments

1

You can speed up your code significantly by:

  1. Looping through a variant array rather than a range
  2. Splitting your IF test into two parts (VBA doesn't shortcircuit so will evaluate both parts of an AND even if the first part is False).

code

Sub Recut()
Dim X
Dim MyDictionary As Object
Dim lngRow As Long
Set MyDictionary = CreateObject("Scripting.Dictionary")

X = Range("A1:B10").Value2
With MyDictionary
For lngRow = 1 To UBound(X)
    If Len(X(lngRow, 1)) > 0 Then
        If Not .Exists(X(lngRow, 1)) Then .Add X(lngRow, 1), X(lngRow, 2)
    End If
Next
End With
End Sub

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.