i have code which is asking me to activate an input file but it may be please help me out

[tiger123]

i have macro vba code whenever i run it is asking me to activate an input file i have bit confused here please help me out

Sub Start()Dim cn As Connection
Set cn = New Connection
On Error Resume Next
cn.Open "Provider=MSDASQL.1; Password=bmx1;SERVER=192.168.1.200;Persist Security Info=True;User ID=root;Data Source=mysql32;Initial Catalog=repository"
On Error GoTo 0
If cn.State = 0 Then
    MsgBox "Connection to db failed"
    End
End If
Set wbi = ActiveWorkbook


Dim wb As Workbook
For Each wb In Workbooks
    If UCase(Left(Trim(wb.Name), 4)) = "TOOL" And InStr(UCase(wb.Name), "FRACTION") > 0 Then
        Set wbm = Workbooks(wb.Name)
        Exit For
    End If
Next wb
If wbi.Name = wbm.Name Then
    MsgBox "Please activate the Input file and run the tool"
    End
End If
Range("a1").Select
tc = Cells(1, 1).CurrentRegion.Columns.Count
tr = Cells(1, 1).CurrentRegion.Rows.Count
cc = tc + 1


trc = wbm.Worksheets("Settings").Cells(1, 1).CurrentRegion.Columns.Count
ReDim clm(trc) As Integer


N = 0
trc = 2
Do While Trim(wbm.Worksheets("Settings").Cells(1, trc)) <> ""
    ch = Trim(UCase(wbm.Worksheets("Settings").Cells(1, trc)))
    For c = 1 To tc
        If UCase(Trim(wbi.ActiveSheet.Cells(1, c))) = ch Then
            clm(N) = c
            Exit For
        End If
    Next c
    If clm(N) = 0 Then
        MsgBox ch & " - column not found in Input File"
        End
    End If
    N = N + 1
    trc = trc + 1
Loop
mx = N - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Set cn = New Connection
cnstr = "Provider=MySQL ODBC 5.2 Unicode Driver;Data Source=" & wbm.Worksheets("Settings").Cells(2, 2) & ";Persist Security Info=False"
cn.Open cnstr
tbl_nam = wbm.Worksheets("Settings").Cells(3, 2)


Set rs = New Recordset
rs.Open "delete from " & tbl_nam, cn, adOpenStatic, adLockOptimistic


r = 2
Do While wbm.Worksheets("abbreviations").Cells(r, 1) <> ""
    sqlstr = "insert into " + tbl_nam + " (literal, syn) values ('" + Replace(wbm.Worksheets("abbreviations").Cells(r, 1), "'", "''") + "', '" + Replace(wbm.Worksheets("abbreviations").Cells(r, 2), "'", "''") + "')"
    Set rs = New Recordset
    rs.Open sqlstr, cn, adOpenStatic, adLockOptimistic
    r = r + 1
Loop


wbi.ActiveSheet.Cells(1, cc) = "Tool Remarks"
dr = 2


wbm.Activate
Worksheets("Tool_Output").Activate
Range("a1").Select
trz = Cells(1, 1).CurrentRegion.Rows.Count
If trz > 1 Then
    ans = MsgBox("Data present in Tool_Output tab.  Delete it ?", vbYesNo)
    If ans = 6 Then
        Cells.Select
        Selection.Delete
        wbi.Activate
    Else
        MsgBox "Execution terminated"
        End
    End If
End If
wbm.Worksheets("Tool_Output").Cells(1, 1) = wbm.Worksheets("Settings").Cells(4, 2)
wbm.Worksheets("Tool_Output").Cells(1, 2) = "Old Value"
wbm.Worksheets("Tool_Output").Cells(1, 3) = "New Value"
'wbm.Worksheets("Tool_Output").Cells(1, 4) = "Replace(Y/N)"
wbi.Activate


'  column search
c1 = 0
For c = 1 To tc
    If Trim(UCase(Cells(1, c))) = UCase(wbm.Worksheets("Settings").Cells(4, 2)) Then
        c1 = c
        Exit For
    End If
Next c
If c1 = 0 Then
    MsgBox wbm.Worksheets("Settings").Cells(4, 2) + " - column not found in input file"
    End
End If


vseparator = UCase(Left(Trim(wbm.Worksheets("Settings").Cells(5, 2)), 1))
If Not (vseparator = "Y" Or vseparator = "N") Then
    MsgBox "Please specify either Y/N in row number 5 of Settings tab"
    End
End If


vReplFullCellValue = UCase(Left(Trim(wbm.Worksheets("Settings").Cells(7, 2)), 1))
If Not (vReplFullCellValue = "Y" Or vReplFullCellValue = "N") Then
    MsgBox "Please specify either Y/N in row number 7 of Settings tab"
    End
End If


' store the uoms into the array
i = 2
Do While wbm.Worksheets("Settings").Cells(6, i) <> ""
    vUom(i) = wbm.Worksheets("Settings").Cells(6, i)
    i = i + 1
Loop
mxi = i - 1


dr = 2
For r = 2 To tr
    rcmt = ""
    For c = 0 To mx
        av = wbi.ActiveSheet.Cells(r, clm(c))
        orgav = av
        
'        av = ""
'        For iCount = Len(orgav) To 1 Step -1
'             If IsNumeric(Mid(orgav, iCount, 1)) Or Mid(orgav, iCount, 1) = "/" Or Mid(orgav, iCount, 1) = "-" Then
'                 i = i + 1
'                 av = Mid(orgav, iCount, 1) & av
'             End If
'
'             If i = 1 Then av = CInt(Mid(av, 1, 1))
'        Next iCount
        
        cmt = ""
        get_abbr
        If cmt <> "" Then
            If rcmt = "" Then
                rcmt = cmt
            Else
                rcmt = rcmt + vbCrLf + cmt
            End If
        End If
        If orgav <> av Then
            wbi.ActiveSheet.Cells(r, clm(c)) = "'" + CStr(av)
            wbm.Worksheets("Tool_output").Cells(dr, 1) = "'" + CStr(wbi.ActiveSheet.Cells(r, c1))
            wbm.Worksheets("Tool_output").Cells(dr, 2) = "'" + orgav
            wbm.Worksheets("Tool_output").Cells(dr, 3) = "'" + av
            dr = dr + 1
            
            If wbi.ActiveSheet.Cells(r, cc) = "" Then
                wbi.ActiveSheet.Cells(r, cc) = "'" & av
            Else
                wbi.ActiveSheet.Cells(r, cc) = wbi.ActiveSheet.Cells(r, cc) & vbCrLf & av
            End If
        End If
        
    Next c
    wbi.ActiveSheet.Cells(r, cc).Select
Next r


MsgBox "Done"


End Sub

 

[Andrew Poulsom]

It means that the wrong workbook is active. It's name begins with TOOL and contains the word FRACTION. I don't know what the correct workbook's name would be though.

 

[tiger123]

i have changed Tool as Sheet3 which is having my data and fraction values
now i getting this error called

Run time error '91':


Object variable or with block variable not set

Sub Start()Dim cn As Connection
Set cn = New Connection
On Error Resume Next
cn.Open "Provider=MSDASQL.1; Password=bmx1;SERVER=192.168.1.200;Persist Security Info=True;User ID=root;Data Source=mysql32;Initial Catalog=repository"
On Error GoTo 0
If cn.State = 0 Then
    MsgBox "Connection to db failed"
    End
End If
Set wbi = ActiveWorkbook


Dim wb As Workbook
For Each wb In Workbooks
    If UCase(Left(Trim(wb.Name), 4)) = "Sheet3" And InStr(UCase(wb.Name), "FRACTION") > 0 Then
        Set wbm = Workbooks(wb.Name)
        Exit For
    End If
Next wb
If wbi.Name = wbm.Name Then    -----------------> error here
    MsgBox "Please activate the Input file and run the tool"
    End
End If

 

[RoryA]

If UCase(Left(Trim(wb.Name), 4)) = "Sheet3"

This can never be true, since Sheet3 is not upper case and it's more than 4 characters. Try:

If UCase(Trim(wb.Name)) = "SHEET3"

instead. Note this is looking at the workbook name, not a worksheet name.