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
Code:
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