Automated Vlookup inVBA

Sometimes we need to use vlookup for more than 1000 rows in a single sheet for discrete columns. Today I'll publish automated vlookup VBA code and it'll take care of all rows even if next row is blank .

Sub autovlookup()
    Dim lookupcell, sheetname, tempcelladdress As String
    Dim cntrow, tempcount As Long
    sheetname = ActiveSheet.Name
    cntrow = Application.WorksheetFunction.CountA(Range("A:A"))
    tempcount = 1
   
   
    On Error Resume Next
    Do
        ActiveCell.Offset(1, 0).Select
        tempcelladdress = Range(ActiveCell.Address).Offset(0, -1).Address
       
   
    If Len(tempcelladdress) = 4 Then
    lookupcell = Mid(tempcelladdress, 2, 1) & Mid(tempcelladdress, 4, 1)
    ElseIf Len(tempcelladdress) = 5 Then
    lookupcell = Mid(tempcelladdress, 2, 1) & Mid(tempcelladdress, 4, 2)
    ElseIf Len(tempcelladdress) = 6 Then
    lookupcell = Mid(tempcelladdress, 2, 1) & Mid(tempcelladdress, 4, 3)
    ElseIf Len(tempcelladdress) = 7 Then
    lookupcell = Mid(tempcelladdress, 2, 1) & Mid(tempcelladdress, 4, 4)
    ElseIf Len(tempcelladdress) = 8 Then
    lookupcell = Mid(tempcelladdress, 2, 1) & Mid(tempcelladdress, 4, 5)
    End If
    If Range(ActiveCell.Address).Offset(0, -1).Value <> "" Then
    tempcount = tempcount + 1
    ActiveCell.Formula = "=vlookup(" & lookupcell & ",'SalesData'!D1:F3457,2,0)"
    End If
   
    Loop Until tempcount = cntrow
End Sub

Remove Special Character in VBA

Some times in excel we face a problem of removing a particular character again & again. Here is VBA code which will automatically remove that special character  from that current sheet of excel.

Sub removeSplchar()
    Dim splchar, tempval, newtempval, newval As String
    Dim cell As Object
    Dim userdefrange As Range
    splchar = InputBox("Enter your spl string:")
    Set userdefrange = ActiveSheet.UsedRange
    On Error Resume Next
    For Each cell In userdefrange
    tempval = cell.Value
        For x = 1 To Len(tempval)
        newtempval = Mid(tempval, x, 1)
            If InStr(newtempval, splchar) = 0 Then
                newval = newval & newtempval
            End If
        Next x
        cell.Value = newval
        newval = ""
    Next cell

End Sub

Login on website using VBA

            Yes!! we can use VBA for web application also.I have faced  a situation where I have to extract sales report  for different locations from web application using different login Id and password. So it's a time comsuming process to login each time with different userid & password. So we can automatize the process using VBA code.

            First of all we have to take two references in Tools menu of VBA Editor

              1. Microsoft HTML object library 

              2.Microsoft Internet Controls

Sample VBA code for this:

Sub loginWebWeX()

Dim htmldoc As HTMLDocument
 Dim browser As InternetExplorer
 Dim surl As String
 Dim objCollection As Object
 Dim objElement As Object
 surl = "https://login.yahoo.com/config/login_verify2?.intl=in&.src=ym"
 On Error GoTo errorhandler
 Set browser = New InternetExplorer
     browser.Silent = True
     browser.navigate surl
     browser.Visible = True
     'MsgBox "Your request is being processed"
     Do While browser.Busy Or browser.ReadyState <> READYSTATE_COMPLETE
                        DoEvents
        Loop
   
    
     Set htmldoc = browser.document
      Set objCollection = htmldoc.getElementsByTagName("Input")
    
                  
     i = 0
     While i < objCollection.Length
    
         If objCollection(i).Name = "username" Then
             objCollection(i).Value = ThisWorkbook.Sheets(1).Range("A1").Value
         ElseIf objCollection(i).Name = "passwd" Then
         objCollection(i).Value = ThisWorkbook.Sheets(1).Range("A2").Value
         End If
         i = i + 1
     Wend
     Set objCollection = Nothing
     Set objCollection = htmldoc.getElementsByTagName("button")
     While j < objCollection.Length
         If objCollection(j).Type = "submit" Then
         Set objElement = objCollection(j)
         objElement.Click
         End If
         j = j + 1
     Wend
    Set objCollection = Nothing
    Set objElement = Nothing
    Set htmldoc = Nothing
    Set browser = Nothing
    Exit Sub
errorhandler:
  MsgBox Err.Description
   
 

End Sub

 

VBA Code for Conditional Coloring of Cell

          Here I am providing you code for conditional coloring of excel cell. This example contains data of Sales Executive,Sales Target and Target Achieved. On clicking on Achiever's List data cells containing more than 90% sales target achieved will be colored.

VBA Code for this as Follows:

Sub selcellbyValue()

Dim salesRange, targetRange As Range

Dim salach, target As Integer

Set salesRange = Application.InputBox("Select Range", "Salesachieved Range", Type:=8)

tempval = 1

For Each cell In salesRange

If cell.Offset(1, 0).Value <> "" Then

salach = cell.Offset(1, 0).Value

target = cell.Offset(1, -1).Value

If (salach / target) > 0.9 Then

cell.Offset(1, 0).Interior.Color = RGB(321, 172, 118)

End If

End If

Next cell

End Sub