Friday, February 24, 2017

copy data from listbox to listbox in vba,vba teacher Sourav,kolkata 09748184075

Private Sub CommandButton1_Click()
Dim signal As Boolean
signal = False
Dim i As Integer
i = ListBox2.ListCount - 1

 While i >= 0
 'MsgBox (i)
 
 
      
          If UserForm1.ListBox2.Selected(i) Then
          
              'MsgBox (ListBox1.List(i))
          
 For j = 0 To UserForm1.ListBox1.ListCount - 1
 If CStr(UserForm1.ListBox2.List(i)) = CStr(UserForm1.ListBox1.List(j)) Then
 'MsgBox ("wrong")
 signal = True
 Exit For
 End If
 Next j
 
 
          
If signal = True Then

Else
'MsgBox ("getting inside")
UserForm1.ListBox1.AddItem (UserForm1.ListBox2.List(i))
UserForm1.ListBox2.RemoveItem (i)

End If

End If
signal = False

          i = i - 1
           Wend
           
           


End Sub

Private Sub CommandButton2_Click()
Dim signal As Boolean
signal = False
Dim i As Integer
i = ListBox1.ListCount - 1

 While i >= 0
 'MsgBox (i)
 
 
      
          If UserForm1.ListBox1.Selected(i) Then
          
              'MsgBox (ListBox1.List(i))
          
 For j = 0 To UserForm1.ListBox2.ListCount - 1
 If CStr(UserForm1.ListBox1.List(i)) = CStr(UserForm1.ListBox2.List(j)) Then
 signal = True
 Exit For
 End If
 Next j
 
 
          
If signal = True Then

Else
UserForm1.ListBox2.AddItem (UserForm1.ListBox1.List(i))
UserForm1.ListBox1.RemoveItem (i)

End If

End If
signal = False

          i = i - 1
           Wend
           
           

End Sub

Private Sub ListBox2_Click()

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
Sheets("Data").Select
Dim source As Range
Range("A2").Select
    While ActiveCell.Value <> ""
    UserForm1.ListBox1.AddItem (ActiveCell.Value)
    ActiveCell.Offset(1, 0).Select
    Wend
    
    
    
    
    
    
    
    
End Sub

Sub test()
For j = 0 To UserForm1.ListBox1.ListCount - 1
 UserForm1.ListBox1.RemoveItem j
 Next j
End Sub

Thursday, February 16, 2017

French MBA College VBA Assignment done,vba teacher sourav,kolkata 09748184075

Sub advancedfilter()
Sheets("Extraction").Select
Cells.Clear
Range("A1").Select
ActiveCell.Value = "CustomerID"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "DateandTime"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Date"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Time"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "ProductID"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "ProductName"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Unit Price"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Quantity"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Total Price"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Discount"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Final Price"
ActiveCell.Offset(0, 1).Select

'January Sheet data copy


Sheets("January").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("A")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False


Sheets("January").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("B")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False


Sheets("January").Select
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("E")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False


Sheets("January").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("H")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False

'February Month Data Copy

Sheets("February").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("A")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False


Sheets("February").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("B")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False


Sheets("February").Select
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("E")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False


Sheets("February").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("H")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False


'March Month Data Copy

Sheets("March").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("A")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False


Sheets("March").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("B")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False


Sheets("March").Select
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("E")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False


Sheets("March").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Extraction").Select
    With Columns("H")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

ActiveSheet.Paste


Application.CutCopyMode = False

Sheets("Extraction").Select
Range("C2").Select

    ActiveCell.Select
    ActiveCell.FormulaR1C1 = _
        "=TEXT(RC[-1],""d"")&""/""&TEXT(RC[-1],""m"")&""/""&TEXT(RC[-1],""yy"")"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A12000")
    ActiveCell.Range("A1:A12000").Select
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=TIME(HOUR(RC[-2]),MINUTE(RC[-2]),SECOND((RC[-2])))"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A12000")
   ActiveCell.Range("A1:A12000").Select

Sheets("Extraction").Select
Range("F2").Select

ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Products!R3C1:R18C3,2,FALSE)"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A12000")
    ActiveCell.Range("A1:A12000").Select
    
    
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Products!R3C1:R18C3,3,FALSE)"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A12000")
    ActiveCell.Range("A1:A12000").Select


Range("I2").Select

    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-2]"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A12000")
    ActiveCell.Range("A1:A12000").Select
    
    Range("J2").Select
      ActiveCell.Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(Extraction!RC[-1],Discounts,2,TRUE)"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A12000")
    ActiveCell.Range("A1:A12000").Select
    Selection.NumberFormat = "0.00%"
    Selection.NumberFormat = "0.0%"
    Selection.NumberFormat = "0%"
    
    
    Range("K2").Select
    
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "=RC[-2]-(RC[-2]*RC[-1])"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A12000")
    ActiveCell.Range("A1:A12000").Select
    Selection.NumberFormat = "0.00"

Range("A:Z").EntireColumn.AutoFit


End Sub

Filtering data from multiple sheets and consolidate into one,french mba college assignment,vba teacher sourav,kolkata 09748184075

Sub filterdata()

Sheets("Extraction").Select
Cells.Clear
Range("A1").Select
ActiveCell.Value = "userID"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Start"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "End"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Duration"

ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Amount"

Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
MsgBox (ws.Name)

If ws.Name = "D1" Or ws.Name = "D2" Or ws.Name = "D3" Then


Sheets(ws.Name).Select

Dim rList As Range
 On Error Resume Next
With Worksheets(ws.Name).ListObjects("Table1")
    Set rList = .Range
    .Unlist                           ' convert the table back to a range
End With


'filter D1
Sheets(ws.Name).Select

Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range(Selection.Address), , xlYes).Name = _
        "Table2"
    Range("Table2[#All]").Select
    ActiveSheet.ListObjects("Table2").TableStyle = "TableStyleLight1"
    ActiveSheet.ListObjects("Table2").Name = "Table1"
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4, Criteria1:= _
        "<8:0 br="" operator:="xlAnd">   
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Extraction").Select
    
    

With Columns("A")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

    ActiveSheet.Paste
    
    'filtering D1 completed
    'convert table to range
    
    
Sheets(ws.Name).Select


 On Error Resume Next
With Worksheets(ws.Name).ListObjects("Table1")
    Set rList = .Range
    .Unlist                           ' convert the table back to a range
End With

'table converted to range

   Application.CutCopyMode = False
   End If
   
Next ws
End Sub

Wednesday, February 15, 2017

Translation using internet explorer and google translate using vba assignment solved,VBA Teacher Sourav,Kolkata 09748184075

Sub print2()
Application.DisplayAlerts = False
Dim count As Integer
count = 0
Dim i As Integer
i = 1
Dim zz As Worksheet
For Each zz In ActiveWorkbook.Worksheets
If i > 5 Then
zz.Delete
End If
i = i + 1
Next zz
Dim langchoice As Integer
   langchoice = CInt(InputBox("Please enter 0 for english,1 for french and other for spanish"))
   
   Dim answerval As String
   answerval = test1(langchoice)
Sheets("Currencies").Select
Range("B2").Select
While ActiveCell.Value <> ""
Dim tempval As String
tempval = ActiveCell.Value
Dim Signal As Boolean
Signal = False
Dim activecelladdress As String
activecelladdress = ActiveCell.Address

For Each oSheet In ActiveWorkbook.Sheets
'activecelladdress = ActiveCell.Address
        If oSheet.Name = tempval Then
            oSheet.Delete
            
            Signal = True
            
            
            
            

        End If
Next oSheet
If Signal = True Then
Signal = False
Else
Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
    ws.Name = tempval
    count = count + 1
    
    ActiveSheet.Range("A2").Select
    ActiveCell.Value = "FullDateAlternateKey"
    ActiveCell.Offset(0, 1).Value = "Average Rate"
    ActiveCell.Offset(0, 2).Value = "EndofDayRate"
    ActiveCell.Offset(0, 3).Value = "Variation"
    ActiveCell.Offset(0, 4).Value = "DayOfTheWeek"
    Sheets("Dates").Select
    Range("B2").Select
     ActiveCell.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets(tempval).Select
    Range("A3").Select
ActiveSheet.Paste

    Application.CutCopyMode = False
    
    
    Sheets("Data").Select
    Range("C2").Select
     ActiveCell.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets(tempval).Select
    Range("B3").Select
ActiveSheet.Paste

    Application.CutCopyMode = False
    
    
    
    
    Sheets("Data").Select
    Range("D2").Select
     ActiveCell.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets(tempval).Select
    Range("C3").Select
ActiveSheet.Paste
Range("C3").Select
     ActiveCell.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "0.0000"
    Application.CutCopyMode = False
    
    
    Sheets("Data").Select
    Range("E1").Select
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A1000")
    ActiveCell.Range("A1:A1000").Select
    Selection.Copy
    Sheets(tempval).Select
    Range("D3").Select
ActiveSheet.Paste
    Range("D3").Select
     ActiveCell.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "0.0000"
    Application.CutCopyMode = False
    Sheets("Data").Select
    Columns(5).EntireColumn.Delete
    Sheets(tempval).Select
    
    'this is for translation
    
   Range("E3").Select
   ActiveCell.Value = answerval
   
   
   'this is for tabular design
   
   Sheets(tempval).Select
    Range("A2:E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:A").EntireColumn.AutoFit
    Range("A1:E1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:F1").Select
    ActiveCell.FormulaR1C1 = "Table By VBA Coding"
   
    Columns("A:E").EntireColumn.AutoFit
    
    Signal = False
    End If
    


Sheets("Currencies").Select
Range(activecelladdress).Select
ActiveCell.Offset(1, 0).Select

Wend

Sheets("tempdata").Delete

MsgBox ("the number of sheets created is " & count)

Application.DisplayAlerts = False

End Sub

 Function test1(ByVal userchoice As String) As String
 Dim ws As Worksheet
 On Error Resume Next
 
    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
    ws.Name = "tempdata"
    Dim s As String
    Sheets("tempdata").Select
    Range("E3").Select
 ActiveCell.FormulaR1C1 = "=TEXT(NOW(),""ddd"")"
 Dim todayval As String
 s = ActiveCell.Value
 ActiveCell.Value = ""
 Dim answer As String
 'Dim userchoice As String
 'userchoice = InputBox("Please enter 0 for english,1 for french and other for spanish")
If userchoice = "0" Then

 answer = transalte_using_vba(s, "en")
ElseIf userchoice = "1" Then
  answer = transalte_using_vba(s, "fr")

Else
  answer = transalte_using_vba(s, "es")

End If
test1 = answer

End Function

Function transalte_using_vba(str, langchoice) As String
' Tools Refrence Select Microsoft internet Control


    Dim IE As Object, i As Long
    Dim inputstring As String, outputstring As String, text_to_convert As String, result_data As String
    Dim CLEAN_DATA
    
    
    
    
    
    

    Set IE = CreateObject("InternetExplorer.application")
    '   TO CHOOSE INPUT LANGUAGE

    inputstring = "auto"

    '   TO CHOOSE OUTPUT LANGUAGE

    outputstring = langchoice

    text_to_convert = str

    'open website

    IE.Visible = False
    
    
    
    
    IE.navigate "http://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert

    Do Until IE.ReadyState = 4
        DoEvents
    Loop

    Application.Wait (Now + TimeValue("0:00:10"))

    Do Until IE.ReadyState = 4
        DoEvents
    Loop

    CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "
", ""), "<")

    For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
        result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
    Next


    IE.Quit
    transalte_using_vba = result_data


End Function

Saturday, January 21, 2017

debugging not working for asp.net and asp.net mvc in monodevelop in ubuntu16 solved

install mono-xsp

copt xsp4.exe from /usr/lib/mono/4.5 and paste it to your applications bin directory

and run it specifying the browser

source:http://stackoverflow.com/questions/22622106/debugging-asp-net-mvc-apps-in-monodevelop-with-xsp4