Thursday, November 22, 2018

Randomly choose between two given characters (for example A and I) and format the row based on that choice using excel,Excel Teacher Sourav,Kolkata 08910141720

=CHAR(CHOOSE(RANDBETWEEN(1,2),65,73))

Or

=CHOOSE(RANDBETWEEN(1,2),"A","I")

Source:https://exceljet.net/formula/random-text-values

Now select the whole section of data ,go to home,conditional formatting ,manage rules,new rule

select use a formula to determine which cells to format

in the formula box write

=$N2="I"

then go to format,under fill tab make sure grey is selected,so that people with
status I (inactive ) have their rows greyed out




Tuesday, November 20, 2018

Load Combobox with Employee ID and Names on initialization of userform ,VBA Teacher Sourav,Kolkata 08910141720

Private Sub UserForm_Initialize()
Call loadcmb
End Sub


Sub loadcmb()
Dim sdsheet As Worksheet
Set sdsheet = ThisWorkbook.Sheets("Sortsheet")
If sdsheet.Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
lr = 2
Else
lr = sdsheet.Cells(Rows.Count, 1).End(xlUp).Row
End If

SortForm.ComboBox1.Clear

For x = 2 To lr

If SortForm.OptionButton1 = True Then

SortForm.ComboBox1.AddItem Sortsheet.Cells(x, 1) & " - " & Sortsheet.Cells(x, 2)


Else

SortForm.ComboBox1.AddItem Sortsheet.Cells(x, 2) & " - " & Sortsheet.Cells(x, 1)

End If


Next x

End Sub

Create random but unique numbers for employee id column in a given range using VBA,VBA Teacher Sourav,Kolkata 08910141720

Sub fillcolumnwithuniquerandomnumbers()

Sheets("Sortsheet").Select
 Dim cell As Range
    Dim rng As Range
    Dim High As Long, Sample As Long
   
  
    'High = Application.InputBox("Enter population total", Type:=1)
    'Sample = Application.InputBox("Enter the Sample Size", Type:=1)
    High = 500
    Low = 1
   
    'Set rng = Application.Range(ActiveCell, ActiveCell.Offset(Sample, 0))
    Set rng = Range("A2:A500")
   
    For Each cell In rng.Cells
        If WorksheetFunction.CountA(rng) = (High - Low + 1) Then Exit For
        Do
            rndNumber = Int((High - Low + 1) * Rnd() + Low)
        Loop Until rng.Cells.Find(rndNumber, LookIn:=xlValues, lookat:=xlWhole) Is Nothing
        cell.Value = rndNumber
    Next
    rng.Select
    Selection.NumberFormat = "@" 'changing the format to text so that cells can contain leading zeros
   
    For Each cell In rng.Cells
    cell.Value = "000" & cell.Value
   
   
   
    Next
   
   
   
End Sub

Thursday, November 15, 2018

Sort excel data from an userform using column names(sort key) in option button using VBA,VBA Teacher Sourav,Kolkata 08910141720





The code behind sort button

Private Sub CommandButton1_Click()

Dim sdsheet As Worksheet
Set sdsheet = ThisWorkbook.Sheets("Sortsheet")
If sdsheet.Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
lr = 2
Else
lr = sdsheet.Cells(Rows.Count, 1).End(xlUp).Row
End If

Set sortarea = Range("A2:L" & lr)
If Me.OptionButton1 = True Then

Set sortcol = Range("A2:A" & lr)
ElseIf Me.OptionButton2 = True Then
Set sortcol = Range("G2:G" & lr)

Else

End If






sdsheet.Sort.SortFields.Clear
sdsheet.Sort.SortFields.Add Key:=sortcol _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With sdsheet.Sort
    .SetRange sortarea
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
End Sub


Source:https://www.youtube.com/watch?v=6Ju6B99eleo&index=2&list=PLw8O1w0Hv2zvnLFyiMrihcaOqA0sT0X2U

Tuesday, September 18, 2018

Automatically Filter data and copy the filtered data and merge it in a sheet with a dynamically created name using VBA,VBA Teacher Sourav,Kolkata 08910141720

Sub automatefilter()
'This is to get the todays date and i like this date as part of the name of the new sheet,however this is not necessary

Dim mydate As String
mydate = Format(Now(), "MMM DD YYYY")

'We need to remove all filters first




Workbooks(ActiveWorkbook.Name).Activate
    Sheets("Sheet1").Activate
    Dim str3 As String
Dim fieldname As Integer


Dim InputBoxRangeCancelVariable As Range

  
ActiveSheet.Cells.Select

Selection.ClearFormats

If ActiveSheet.AutoFilterMode Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
End If

'Now we need to get the data by which we are going to filter



    On Error Resume Next

    Set InputBoxRangeCancelVariable = Application.InputBox(Prompt:="Please select the cell which contains basis of the filter", Type:=8)

    On Error GoTo 0

    If InputBoxRangeCancelVariable Is Nothing Then

       MsgBox ("You have not selected anything")
       GoTo 0
    Else

        str3 = InputBoxRangeCancelVariable.Value
      

    End If
'We need to find the address of the range to be filtered which is expanding horizantally


    Sheets("Sheet1").Activate
ActiveSheet.Range("A1").Select
  
    Dim i As Long
    Dim count As Integer

    Dim str1 As String
    For i = 1 To 500000
    If ActiveCell.Value = "DOA(Month)" Then

    str1 = ActiveCell.Address
    Exit For
    Else
    ActiveCell.Offset(0, 1).Select
End If

  
  
  
  
  
    Next i
   
   
   
   ActiveSheet.Range(str1).Select
    For i = 1 To 500000
    If ActiveCell.Value = "" Then
  
    Exit For
    Else
    str1 = ActiveCell.Address
  
  
    ActiveCell.Offset(1, 0).Select
   
End If

  
  
  
  
  
    Next i
   str1 = Replace(str1, "$", "")
  
 For i = 1 To Len(str1)
If IsNumeric(Mid(str1, i, 1)) = False Then

temp = temp + Mid(str1, i, 1)

End If




 Next i


fieldname = Range(temp & 1).Column

 
    Dim str2 As String
    str2 = "A1:" & str1
 
   Selection.Clear



     ActiveSheet.Range(str2).AutoFilter Field:=fieldname, Criteria1:=str3
  

  
'as you have seen we are able to get the filtered data ,now let's create a sheet and copy paste the filtered data in the new sheet
'or there is a old sheet and we have to append the filtered data inside it,that'sour requirement

'Now let's create another sheet






str3 = str3 + " " + mydate

Dim signal As Boolean
signal = False


For i = 1 To ActiveWorkbook.Sheets.count



If ActiveWorkbook.Sheets(i).Name = str3 Then
signal = True
End If




Next i

If signal = False Then
'create the sheet as it is not present,and copy the filtered data with headers


Worksheets.Add(After:=Worksheets(Worksheets.count)).Name = str3
'copy and paste
Sheets("Sheet1").Select

 Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets(str3).Select
    Range("A1").Select
   
    ActiveSheet.Paste
Else
'here the sheet is already present


Sheets(str3).Activate
If Range("A1").Value <> "" Then



Sheets("Sheet1").Select

 Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
   
  Else
  Sheets("Sheet1").Select

 Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

End If

Sheets(str3).Select
Range("A1").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select




Wend

ActiveSheet.Paste


End If
Application.CutCopyMode = False

  
  
0:
End Sub