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