I tried it .
But Code seems not right.
Option Explicit
Private Sub auto_open()
With Application
With .CommandBars("Tools")
With .Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
.FaceId = 346
.Caption = "Word Check"""
.OnAction = "total_check_mac"
End With
End With
End With
End Sub
Sub Addin_close(Optional x As Boolean)
On Error GoTo er
With Application
With .CommandBars("Tools")
.Controls("Word Check").Delete
End With
End With
er:
End Sub
Sub total_check_mac()
Dim varData As Variant
Dim lngRow As Long, lngI As Long, L As Long, N As Long
Dim rngTarget As Range
On Error GoTo er
If ActiveWorkbook Is ThisWorkbook Then
MsgBox "It can't proceed in this workbook.", vbInformation
Exit Sub
Else
If MsgBox("Start Word Check?", _
vbInformation + vbOKCancel) = vbCancel Then
Exit Sub
End If
End If
With ThisWorkbook.Sheets(1)
lngRow = .Cells(65536, 1).End(xlUp).Row
varData = .Range("A1:B" & lngRow).Value
End With
Set rngTarget = Selection
If rngTarget.Cells.Count = 1 Then
Set rngTarget = Cells
End If
N = rngTarget.End(xlUp).Row
For lngI = 2 To N Step 2
For L = 2 To IngRow
If InStr(Cells(Ingl, rngTarget.Column), varData(L, 1)) > 0 Then
If InStr(Cells(Ingl + 1, rngTarget.Column), varData(L, 2), varData(L, 3), varData(L, 4)) > 0 Then
Cells(Ingl, 21) = varData(L, 1)
End If
End If
Next L
Next lngI
Application.OnTime Now, "success_msg"
er:
End Sub
Sub success_msg(Optional x As Boolean)
MsgBox "Wrod Check is done.", vbInformation
End Sub
Bookmarks