Tuesday, April 12, 2016

My stupid version of vlookup(only exact lookup) ,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, "$", "")
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

Dim j As Integer

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

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 Sub

Thursday, April 7, 2016

My stupid version of Sumifs(with the greater than or less than feature) ,vba macro

Sub test1()



Dim colnum2 As Integer

Dim col2, col3 As String

Dim ws As Worksheet

Set ws = ActiveSheet

Dim colname As String
Dim i As String
Dim j As Integer

Dim sum As Integer
Dim k As Integer
Dim colnum As Integer
Dim rownum As Integer
rownum = 0
Dim truth As Integer
truth = 0
Dim signal As Integer
signal = 0

k = 0

Dim criterias() As String
Dim trutharr() As Integer


sum = 0


j = 0


 i = ActiveCell.Value
' MsgBox (i)
 
   While i <> ""
 j = j + 1

  ActiveCell.Offset(0, 1).Select
 
    i = ActiveCell.Value
   
 ' MsgBox (i)
 
 
 
 
 
  Wend
 
 
 
 ' MsgBox ("the number of columns are " & j)
  colnum = j
 
 
  ReDim criterias(1 To j) As String
  ReDim trutharr(1 To j) As Integer
 
For k = 1 To j - 1

criterias(k) = InputBox("Give me some input")


Next k

 
 
 
 
 

 
 
  For k = 1 To j
 
  ActiveCell.Offset(0, -1).Select
 
  Next k
' MsgBox (ActiveCell.Address)
 i = ActiveCell.Value
 j = 0

  While i <> ""
 j = j + 1

  ActiveCell.Offset(1, 0).Select
 
    i = ActiveCell.Value
   
 ' MsgBox (i)
 
 
 
 
 
  Wend

' MsgBox ("The selection has " & j & " rows")

 rownum = j

 MsgBox (ActiveCell.Address)

 For k = 1 To rownum
 
  ActiveCell.Offset(-1, 0).Select
 
  Next k
MsgBox (ActiveCell.Address)
 Dim ans2 As String
 Dim ans3 As String
 ans3 = ""
 Dim l As Integer

 For j = 1 To rownum

 For k = 1 To colnum


  ans3 = ""

 ActiveCell.Offset(0, 1).Select

 MsgBox (ActiveCell.Address)
 If InStr(criterias(k), ">") > 0 Or InStr(criterias(k), "<") > 0 Then

 ans2 = ActiveCell.Value & Trim(criterias(k))
 'MsgBox (ans2)
 For l = 1 To Len(ans2)

If IsNumeric(Mid(ans2, l, 1)) = True And IsNumeric(Mid(ans2, l + 1, 1)) = False Then

ans3 = ans3 + Mid(ans2, l, 1) + " "

ElseIf IsNumeric(Mid(ans2, l, 1)) = False And IsNumeric(Mid(ans2, l + 1, 1)) = True Then

ans3 = ans3 + Mid(ans2, l, 1) + " "

Else
ans3 = ans3 + Mid(ans2, l, 1)

End If


Next l

Dim leftstr As String
leftstr = ""
l = 1

While Not Mid(ans3, l, 1) = " "

leftstr = leftstr + Mid(ans3, l, 1)

l = l + 1
Wend

MsgBox (l)

Dim rightstr As String
rightstr = ""

For l = l To Len(ans3)
If IsNumeric(Mid(ans3, l, 1)) Then
rightstr = rightstr + Mid(ans3, l, 1)
End If

Next l


Dim midstr As String

midstr = ""
For l = Len(leftstr) + 1 To (Len(ans3) - Len(rightstr) - 1)

midstr = midstr + Mid(ans3, l, 1)


Next l
MsgBox (leftstr & midstr & rightstr)
If CBool(Evaluate(Replace(Replace(Replace("leftstr midstr rightstr", "leftstr", leftstr), "midstr", midstr), "rightstr", rightstr))) = True Then
MsgBox ("true")


 truth = 1
 Else
 truth = 0
 End If


 Else

 If IsNumeric(criterias(k)) And IsNumeric(ActiveCell.Value) Then
' MsgBox ("criterias(k): " & criterias(k) & " ActiveCell.Value:" & ActiveCell.Value)

 If CInt(ActiveCell.Value) = CInt(criterias(k)) Then
' MsgBox ("criterias(k): " & criterias(k) & " ActiveCell.Value:" & ActiveCell.Value & " are matching")
 truth = 1
 Else
 truth = 0
 End If
 Else
 If ActiveCell.Value = criterias(k) Then
'MsgBox ("criterias(k): " & criterias(k) & " ActiveCell.Value:" & ActiveCell.Value & " are matching")
 truth = 1
 Else
 truth = 0
 End If

 End If
 End If

 trutharr(k) = truth


 Next k

 For k = 1 To colnum
 ActiveCell.Offset(0, -1).Select

 Next k
 'MsgBox (ActiveCell.Address)
 For k = 1 To UBound(trutharr)



 If trutharr(k) = 0 Then
 signal = 1

 Exit For


 End If
 Next k
 If signal = 0 Then
 sum = sum + ActiveCell.Value
 End If
 signal = 0

 truth = 0

 ActiveCell.Offset(1, 0).Select

 MsgBox (sum)



 Next j

 For k = 1 To rownum

 ActiveCell.Offset(-1, 0).Select


 Next k

 MsgBox ("the result is " & sum)

  colname = ActiveCell.Address
  col2 = Replace(colname, "$", "")
 For j = 1 To Len(col2)
        If Not IsNumeric(Mid(col2, j, 1)) Then
            col3 = col3 & Mid(col2, j, 1)
        End If
    Next j
  colnum2 = (Range(col3 & 1).Column)
 
  For Each cell In ws.Columns(colnum2).Cells
 
 
  If IsEmpty(cell) = True Then cell.Select: Exit For
Next cell
  ActiveCell.Value = "hello the result is " & sum
 
  ActiveCell.EntireColumn.AutoFit
End Sub

Tuesday, April 5, 2016

My stupid version of Sumifs(without the greater than or less than feature) ,vba macro

Sub test1()



Dim colnum2 As Integer

Dim col2, col3 As String

Dim ws As Worksheet

Set ws = ActiveSheet

Dim colname As String
Dim i As String
Dim j As Integer

Dim sum As Integer
Dim k As Integer
Dim colnum As Integer
Dim rownum As Integer
rownum = 0
Dim truth As Integer
truth = 0
Dim signal As Integer
signal = 0

k = 0

Dim criterias() As String
Dim trutharr() As Integer


sum = 0


j = 0


 i = ActiveCell.Value
' MsgBox (i)
  
   While i <> ""
 j = j + 1

  ActiveCell.Offset(0, 1).Select
  
    i = ActiveCell.Value
    
 ' MsgBox (i)
  
  
  
  
  
  Wend
  
  
  
 ' MsgBox ("the number of columns are " & j)
  colnum = j
  
  
  ReDim criterias(1 To j) As String
  ReDim trutharr(1 To j) As Integer
  
For k = 1 To j - 1

criterias(k) = InputBox("Give me some input")


Next k

  
  
  
  
  

  
  
  For k = 1 To j
  
  ActiveCell.Offset(0, -1).Select
  
  Next k
' MsgBox (ActiveCell.Address)
 i = ActiveCell.Value
 j = 0

  While i <> ""
 j = j + 1

  ActiveCell.Offset(1, 0).Select
  
    i = ActiveCell.Value
    
 ' MsgBox (i)
  
  
  
  
  
  Wend

' MsgBox ("The selection has " & j & " rows")

 rownum = j

 MsgBox (ActiveCell.Address)

 For k = 1 To rownum
  
  ActiveCell.Offset(-1, 0).Select
  
  Next k
'MsgBox (ActiveCell.Address)



 For j = 1 To rownum

 For k = 1 To colnum




 ActiveCell.Offset(0, 1).Select
 If IsNumeric(criterias(k)) And IsNumeric(ActiveCell.Value) Then
' MsgBox ("criterias(k): " & criterias(k) & " ActiveCell.Value:" & ActiveCell.Value)

 If CInt(ActiveCell.Value) = CInt(criterias(k)) Then
' MsgBox ("criterias(k): " & criterias(k) & " ActiveCell.Value:" & ActiveCell.Value & " are matching")
 truth = 1
 Else
 truth = 0
 End If
 Else
 If ActiveCell.Value = criterias(k) Then
'MsgBox ("criterias(k): " & criterias(k) & " ActiveCell.Value:" & ActiveCell.Value & " are matching")
 truth = 1
 Else
 truth = 0
 End If

 End If
 trutharr(k) = truth


 Next k

 For k = 1 To colnum
 ActiveCell.Offset(0, -1).Select

 Next k
 'MsgBox (ActiveCell.Address)
 For k = 1 To UBound(trutharr)



 If trutharr(k) = 0 Then
 signal = 1

 Exit For


 End If
 Next k
 If signal = 0 Then
 sum = sum + ActiveCell.Value
 End If
 signal = 0

 truth = 0

 ActiveCell.Offset(1, 0).Select




 Next j

 For k = 1 To rownum

 ActiveCell.Offset(-1, 0).Select


 Next k

 MsgBox ("the result is " & sum)

  colname = ActiveCell.Address
  col2 = Replace(colname, "$", "")
 For j = 1 To Len(col2)
        If Not IsNumeric(Mid(col2, j, 1)) Then
            col3 = col3 & Mid(col2, j, 1)
        End If
    Next j
  colnum2 = (Range(col3 & 1).Column)
  
  For Each cell In ws.Columns(colnum2).Cells
  
  
  If IsEmpty(cell) = True Then cell.Select: Exit For
Next cell
  ActiveCell.Value = "hello the result is " & sum
  
  ActiveCell.EntireColumn.AutoFit
End Sub

My stupid version of autosum macro

Sub add()

Dim c As Range
Dim i As Integer
Dim colname As String
Dim col2 As String
Dim col3 As String
col3 = ""
Dim ws As Worksheet

Set ws = ActiveSheet
Dim colnum As Integer
i = 0
Dim result As Integer


    For Each c In Selection
    colname = ActiveCell.Address
    'MsgBox (colname)
       i = i + c.Value
Next c
result = i


col2 = Replace(colname, "$", "")
 For i = 1 To Len(col2)
        If Not IsNumeric(Mid(col2, i, 1)) Then
            col3 = col3 & Mid(col2, i, 1)
        End If
    Next i
    

MsgBox (col3)

  
colnum = (Range(col3 & 1).Column)
 
  For Each cell In ws.Columns(colnum).Cells
 
 
  If IsEmpty(cell) = True Then cell.Select: Exit For
Next cell
  ActiveCell.Value = "hello the result is " & result
 
  ActiveCell.EntireColumn.AutoFit
   
 
 
 


End Sub