Help, content control and array lookup?
Hey all
I'm new to vba and I'm trying to get this code to work.
Task:
1. User selects a entry in the CC dropdownlist.
2. If the same value exist in the file c:\test.xls column A, then return the Column B value in the same raw.
3. Use the returned value in the CC dropdownlist (or in a new CC textbox)
I hope someone can be kind enough, to come up with a proposal to complete this code.
thank you
Sub Validate_ContentControl()
Dim oCC As ContentControl
Dim OCCEntry As ContentControlListEntry
Set oCC = ActiveDocument.ContentControls(1)
For i = 1 To oCC.DropdownListEntries.Count
If oCC.DropdownListEntries.Item(i).Text = oCC.Range.Text Then
Set OCCEntry = oCC.DropdownListEntries.Item(i)
End If
Next i
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim xlrange1 As Object
Dim xlrange2 As Object
Dim myarray As Variant
Dim Findarray As Variant
Dim Replarray As Variant
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
bstartApp = True
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
With xlapp
Set xlbook = .Workbooks.Open("C:\test.xls")
Set xlsheet = xlbook.Worksheets(1)
With xlsheet
Set xlrange1 = .Range("A1", .Range("A1").End(4))
Set xlrange2 = .Range("B1", .Range("B1").End(4))
Findarray = xlrange1.Value
Replarray = xlrange2.Value
End With
End With
If bstartApp = True Then
xlapp.Quit
End If
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
Set xlrange1 = Nothing
Set xlrange2 = Nothing
For i = 2 To UBound(Findarray)
If OCCEntry.Value = Findarray(i, 1) Then
MsgBox "Found match"
oCC.Range.Text = Replarray(i, 1)
Else: MsgBox "None found"
End If
Exit For
Next i
End Sub
|