Tuesday, April 12, 2016

My stupid version of vlookup(exact and approximate) ,vba macro, Sourav Bhattacharya



Sub vlookup_macro()

Dim selectlookup As Range

Dim lookupval As String

Set selectlookup = Application.InputBox(prompt:="select the cell containing a lookup value", Type:=8)

MsgBox (selectlookup.Address)
lookupval = (selectlookup.Value)
MsgBox (lookupval)

Dim selectrange As Range
Dim selectedarea As String
Set selectrange = Application.InputBox(prompt:="select the cells containing lookup range", Type:=8)
selectedarea = selectrange.Address
selectedarea = Replace(selectedarea, "quot;, "")
Dim selectedarea2 As String

MsgBox (selectedarea)
Dim firstnum As Integer
Dim secondnum As Integer
selectedarea2 = Replace(selectedarea, ":", "")
firstnum = CInt(Mid(selectedarea2, 2, 1))
secondnum = CInt(Mid(selectedarea2, Len(selectedarea2), 1))
MsgBox ("firstnum is: " & firstnum & "secondnum is: " & secondnum)


Dim first As String
first = Mid(selectedarea, 1, 2)
MsgBox ("selected area is " & selectedarea)

Dim last As Integer



last = CInt(Mid(selectedarea, Len(selectedarea), 1))
MsgBox ("last is " & last)


Dim firstcolnum As Integer

firstcolnum = CInt((Range(selectedarea & 1).Column))

MsgBox (firstcolnum)

Dim secondcolnum As Integer


secondcolnum = CInt(Range(Mid(selectedarea, Len(selectedarea) - 1, 1) & 1).Column)



MsgBox (secondcolnum)

Range(first).Select
MsgBox (ActiveCell.Address)
Dim coluser As Integer
coluser = CInt(InputBox("Enter the column number"))


MsgBox (coluser)

Dim i As Integer

MsgBox (firstcolnum)

MsgBox (coluser)

'For i = 1 To (coluser - 1)



'ActiveCell.Offset(0, 1).Select




'Next i

MsgBox (ActiveCell.Address)
Dim test1 As Integer
Dim test2 As String
Dim result As String
result = ""
Dim k As Integer
k = (secondnum - firstnum) + 1

Dim j As Integer
Dim compare() As Integer
ReDim compare(k) As Integer

Dim x, y As Integer
Dim temp As Integer


Dim match As Integer
match = InputBox("choose match option 1 or 0")



For i = 1 To ((secondnum - firstnum) + 1)

MsgBox ("lookupval " & lookupval & " and activecell.Value " & ActiveCell.Value & " are being compaired ")

If IsNumeric(lookupval) Then

If IsNumeric(ActiveCell.Value) Then
If CInt(lookupval) = CInt(ActiveCell.Value) Then
MsgBox ("found")
For j = 1 To (coluser - 1)



ActiveCell.Offset(0, 1).Select




Next j
MsgBox ("The result is " & ActiveCell.Value)
result = (ActiveCell.Value)
Exit For


Else
ActiveCell.Offset(1, 0).Select
End If
Else

MsgBox ("got an issue")

Exit Sub
End If
Else
If Trim(lookupval) = Trim(ActiveCell.Value) Then
MsgBox ("found")
For j = 1 To (coluser - 1)



ActiveCell.Offset(0, 1).Select




Next j
MsgBox ("The result is " & ActiveCell.Value)
result = (ActiveCell.Value)
Exit For


Else
ActiveCell.Offset(1, 0).Select
End If
End If




Next i
If Not result = "" Then

MsgBox (result)

Dim position As Range
Set position = Application.InputBox(prompt:="select the cell for the lookup value to appear", Type:=8)
position.Value = result

End If

If result = "" And match = 1 And IsNumeric(lookupval) = True Then
Range(first).Select
MsgBox (ActiveCell.Address)

For i = 1 To ((secondnum - firstnum) + 1)

MsgBox ("lookupval " & lookupval & " and activecell.Value " & ActiveCell.Value & " are being compaired ")
If CInt(ActiveCell.Value) < CInt(lookupval) Then

compare(i) = CInt(ActiveCell.Value)
'For j = 1 To (coluser - 1)



'ActiveCell.Offset(0, 1).Select




'Next j

ActiveCell.Offset(1, 0).Select

Else
ActiveCell.Offset(1, 0).Select
End If









Next i
For x = 1 To UBound(compare())

For y = x + 1 To UBound(compare)

If compare(x) > compare(y) Then

temp = compare(x)

compare(x) = compare(y)
compare(y) = temp
Else
End If

count = count + 1




Next y





Next x


For i = 1 To UBound(compare())

MsgBox (compare(i))


Next i

Range(first).Select
MsgBox (ActiveCell.Address)

For i = 1 To ((secondnum - firstnum) + 1)

If CInt(ActiveCell.Value) = CInt(compare(UBound(compare))) Then

For j = 1 To (coluser - 1)



ActiveCell.Offset(0, 1).Select




Next j
MsgBox (ActiveCell.Value)
result = ActiveCell.Value

Exit For

Else
ActiveCell.Offset(1, 0).Select
End If



Next i

Else



End If

Set position = Application.InputBox(prompt:="select the cell for the lookup value to appear", Type:=8)
position.Value = result


End Sub

No comments:

Post a Comment