more advanced version of vlookup macro,Sourav VBA Teacher

Sub callvlookup()
Dim selectrange As Range
Dim i As Integer
Dim lookupval As String

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

Dim selectedarea As String


selectedarea = selectrange.Address
selectedarea = Replace(selectedarea, "$", "")
Dim selectedarea2 As String

'MsgBox (selectedarea)
Dim firstnum As Integer
Dim secondnum As Integer
selectedarea2 = Replace(selectedarea, ":", "")
'MsgBox ("2 is " & selectedarea2)
Dim numbers(2) As String
Dim count As Integer
count = 0

For i = 1 To Len(selectedarea)
If Mid(selectedarea, i, 1) = ":" Then

'MsgBox ("true")
Exit For

Else
count = count + 1

End If


Next i

'MsgBox (count)
For i = 1 To count
If IsNumeric(Mid(selectedarea, i, 1)) = True Then
numbers(1) = numbers(1) + Mid(selectedarea, i, 1)

Else
End If


Next i

firstnum = CInt(numbers(1))
For i = (count + 2) To Len(selectedarea)
If IsNumeric(Mid(selectedarea, i, 1)) = True Then
numbers(2) = numbers(2) + Mid(selectedarea, i, 1)

Else
End If


Next i
secondnum = CInt(numbers(2))

'MsgBox ("firstnum is: " & numbers(1) & "secondnum is: " & numbers(2))
MsgBox ("selectedarea is " & selectedarea)

Dim first As String
first = Mid(selectedarea, 1, InStr(selectedarea, ":") - 1)
Range(first).Select
MsgBox (ActiveCell.Address)

Dim numlookup As Integer
Dim numlookup2 As String
numlookup2 = ""

For i = Len(first) To 1 Step -1

If IsNumeric(Mid(first, i, 1)) = True Then

numlookup2 = numlookup2 + Mid(first, i, 1)

Else
End If






Next i
numlookup2 = StrReverse(numlookup2)

numlookup = (CInt(numlookup2))
MsgBox ("numlookup is :" & numlookup)
MsgBox ("first part of first is : " & Mid(first, 1, (Len(first) - Len(numlookup2))))

Dim realloc As String
realloc = Mid(first, 1, (Len(first) - Len(numlookup2))) & numlookup


For i = 1 To ((secondnum - firstnum) + 1)
realloc = Mid(first, 1, (Len(first) - Len(numlookup2))) & numlookup
Range(realloc).Select

MsgBox (ActiveCell.Address)

If ActiveCell.Value <> "" Then

Call vlookup_macro(ActiveCell.Value)
numlookup = numlookup + 1


Else
Exit For





End If




Next i

End Sub


Sub vlookup_macro(lookupval As String)
Dim temp2 As Integer
Dim count As Integer

Dim selectlookup As Range





'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, "$", "")
Dim selectedarea2 As String

'MsgBox (selectedarea)
Dim firstnum As Integer
Dim secondnum As Integer
selectedarea2 = Replace(selectedarea, ":", "")
Dim numbers(2) As String

count = 0

For i = 1 To Len(selectedarea)
If Mid(selectedarea, i, 1) = ":" Then

'MsgBox ("true")
Exit For

Else
count = count + 1

End If


Next i

'MsgBox (count)
For i = 1 To count
If IsNumeric(Mid(selectedarea, i, 1)) = True Then
numbers(1) = numbers(1) + Mid(selectedarea, i, 1)

Else
End If


Next i

firstnum = CInt(numbers(1))
For i = (count + 2) To Len(selectedarea)
If IsNumeric(Mid(selectedarea, i, 1)) = True Then
numbers(2) = numbers(2) + Mid(selectedarea, i, 1)

Else
End If


Next i
secondnum = CInt(numbers(2))
'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, InStr(selectedarea, ":") - 1)
'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)


'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(less than) or 0(exact) or -1(greater than)")



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

ElseIf result = "" And match = -1 And IsNumeric(lookupval) = True Then
For x = 1 To UBound(compare)
compare(x) = 0



Next x

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))
If CInt(compare(i)) <> 0 Then
temp2 = compare(i)
Exit For


End If


Next i
'MsgBox ("the temp2 is " & temp2)

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

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

If CInt(ActiveCell.Value) = CInt(temp2) 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




End If

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


End Sub