Sunday, December 23, 2018

Delete Row from the Table when you have multiple tables on the same sheet

My client has query was to delete a row from the table. It sounds easy. But when the same sheet has more than two tables starting from the same row (defiantly from the different columns) it's a bit tricky to delete only a row from the Specific table.

let's say in the same worksheet You have Table1 and Table2 and you want to delete a row from table 1 dynamically by just selecting a cell inside the table range that's how my client wants to remove a row.



I prepared the workbook to show the demo to delete a row of specific table range by selecting the cell inside of it.

Here is the Code :

Private Sub CommandButton1_Click()
    
    If ActiveCell.Value = vbNullString Then Exit Sub
    
    Const RestrictedRow As Byte = 1
    Const FirstColofTable1 As Long = 1
    Const LastColofTable1 As Long = 5
    Const FirstColofTable2 As Long = 7
    Const LastColofTable2 As Long = 11
    Const Table1LeftIndex As String = "A"
    Const Table1RightIndex As String = "E"
    Const Table2LeftIndex As String = "G"
    Const Table2RightIndex As String = "K"
    Dim ActiveCellRow As Long
    Dim ActiveColumn As Long
    
    ActiveCellRow = VBA.Val(ActiveCell.Row)
    ActiveColumn = VBA.Val(ActiveCell.Column)

    If ActiveCellRow = RestrictedRow Then Exit Sub 

        
    With Sheets("Sheet2")
        If FirstColofTable1 <= ActiveColumn And ActiveColumn <= LastColofTable1 Then
            Sheets("Sheet2").Range(Table1LeftIndex & ActiveCellRow & ":" & Table1RightIndex & ActiveCellRow).Delete shift:=xlUp
        ElseIf FirstColofTable2 <= ActiveColumn And ActiveColumn <= LastColofTable2 Then
            Sheets("Sheet2").Range(Table2LeftIndex & ActiveCellRow & ":" & Table2RightIndex & ActiveCellRow).Delete shift:=xlUp
        End If
    End With
    
    MsgBox "Deleted"
    
End Sub

Tuesday, December 11, 2018

If my input is 1,2 & 3 then result should be 1,2,3,12,13,23,123

Q. Need VBA code to get different combinations. Eg. if my input is 1 & 2 then the result should be 1,2,12.
If my input is 1, 2 & 3 then result should be 1,2,3,12,13,23,123

Input can go up to 20 digits also
Also, result 12 and 21 should treat as same
Similarly, 123 & 321 or 231 or 312 is the same.




here is the perfect dynamic solution. You can add more than 20 digits and it will still provide you with the perfect result.

Put the following code in the module and that's it. I was working on this since yesterday. :D


Tuesday, December 4, 2018

Using Spin Button, Hide & Show the column one by one in Excel VBA

Show and Hide Columns one by one by Spin button up to mentioned columns limits.

this is going to be the best small tool for excel users.

here is the video. and here is the code of Spin Button.



Private Const DefaltWidth As Integer = 9
Dim TargetSheetName As String
Dim TargetSheet As Worksheet
Dim FirstColNo As Integer
Dim LastColNo As Integer
Dim I As Integer

Private Sub SpinButton1_SpinDown()
    Application.ScreenUpdating = False
    'Assigning Values to the Variables
    TargetSheetName = "Sheet1"
    Set TargetSheet = Application.ThisWorkbook.Sheets(TargetSheetName)
    FirstColNo = TargetSheet.Range("A7").Value
    LastColNo = TargetSheet.Range("A9").Value
    If TargetSheet.Range("A7").Value = Empty Or TargetSheet.Range("A9").Value = Empty Then
        MsgBox "Please Set The  Column Range Limits Before You Proceed", vbCritical, "Kamal Bharakhda"
        Exit Sub
    End If
    'Code For Unhiding Columns One By One from Limit One to Last Column
    For I = LastColNo To FirstColNo Step -1
        If TargetSheet.Columns(I).ColumnWidth = 0 Then
            TargetSheet.Columns(I).ColumnWidth = DefaltWidth
            Exit For 'This is most important point if you want to show columns one by one.
        End If
    Next I
    Set TargetSheet = Nothing
    Application.ScreenUpdating = True
End Sub

Private Sub SpinButton1_SpinUp()
    Application.ScreenUpdating = False
    'Assigning Values to the Variables
    TargetSheetName = "Sheet1"
    Set TargetSheet = Application.ThisWorkbook.Sheets(TargetSheetName)
    FirstColNo = TargetSheet.Range("A7").Value
    LastColNo = TargetSheet.Range("A9").Value
    If TargetSheet.Range("A7").Value = Empty Or TargetSheet.Range("A9").Value = Empty Then
        MsgBox "Please Set The  Column Range Limits Before You Proceed", vbCritical, "Kamal Bharakhda"
        Exit Sub
    End If
    'Code For Hiding Columns One By One from Limit One to Last Column
    For I = FirstColNo To LastColNo Step 1
        If TargetSheet.Columns(I).ColumnWidth > 0 Then
            TargetSheet.Columns(I).ColumnWidth = 0
            Exit For 'This is most important point if you want to hide columns one by one.
        End If
    Next I
    Set TargetSheet = Nothing
    Application.ScreenUpdating = True
End Sub

Tuesday, November 27, 2018

Working With NAMED Ranges in VBA

1. The code to change the value of each cell of the name range at the same time

Sub Change_the_Value_of_Each_cell_in_Named_Range()
    Dim NameRange As Range
    Set NameRange = Range("SALES")
    Dim Eachcell As Range
    For Each Eachcell In NameRange
        Eachcell.Value = "Sales" & "2017"
    Next Eachcell
    MsgBox "Done"
End Sub

2. Let's Say You have a list of Named Range in Sheet3 where you want to change the value of each Named Range with the Same Format

Sub Change_The_Value_of_Each_Named_Range()
    Dim I As Long
    I = 2
    Dim SheetName As String
    SheetName = "Sheet3"
    Dim TargetRange As Range
    Do Until Sheets(SheetName).Cells(I, 1).Value = vbNullString
        Set TargetRange = Range(Sheets(SheetName).Cells(I, 1).Value)
        TargetRange.Value = Sheets(SheetName).Cells(I, 1).Value & VBA.Format(Sheets(SheetName).Range("B6").Value, "YYYY")
    I = I + 1
    Loop
End Sub

3. TO RENAME THE WHOLE NAMED RANGES with EXACT FORMAT

Sub Rename_The_Name_Range()

    Dim SheetName As String
    SheetName = "Sheet3"
    Dim TargetSheet As Worksheet
    Set TargetSheet = Sheets(SheetName)
    Dim TargetNamedRange As Name
    Dim CurrentName As String
    Dim Iname As String
    Dim OriginalNamePlace As Integer
    Dim HelperString As String
    For Each TargetNamedRange In ThisWorkbook.Names
        Iname = TargetNamedRange.Name
        If VBA.InStr(1, Iname, "_") = 0 Then
            CurrentName = Iname & VBA.Format(VBA.Date, "_yyyy")
            ThisWorkbook.Names(Iname).Name = CurrentName
        Else
            OriginalNamePlace = VBA.InStr(1, Iname, "_")
            HelperString = VBA.Left(Iname, OriginalNamePlace - 1)
            CurrentName = HelperString & VBA.Format(VBA.Date, "_yyyy")
            ThisWorkbook.Names(Iname).Name = CurrentName
        End If
    Next TargetNamedRange
    MsgBox "Done"
End Sub

Timer in Excel Using VBA

Gift Your self a Nice Timer in Excel Using VBA

Just Give It A Try!


Step 1: Insert an Userform

Step 2: Locate the SHOWMODAL Property of The Userform and make it FALSE

Step 3: Design the userform you as you are seeing in video or you can design your own. it's up to you.

Step 4: Inert a New Module and paste the following code into it.

Sub ()
UserForm2.Show vbModeless
End Sub

Step 5: Double Click on a button on the userform which will start the clock and paste the following code in it.

Private Sub CommandButton1_Click()
Do
DoEvents
UserForm2.Label1.Caption = VBA.Time
Loop
End Sub

Step 6: Paste the following code to close the Timer
Private Sub CommandButton2_Click()
Unload UserForm2
End Sub

Step 7: Put a Button on the Sheet and assign macro named as "Open_Timer"
and it's done! enjoy friend.

By Kamal Bharakhda

Sunday, November 25, 2018

The completely dynamic way to Rename the Shapes in Excel VBA




Sub Rename_Shape()

Dim SheetName As String
SheetName = "Sheet1"

Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets(SheetName)

WS.Activate

Dim Shp As Shape

Dim ShapeName As String
ShapeName = vbNullString

Dim ShapeSelected As String
Dim NewNameofShape As String

For Each Shp In WS.Shapes
ShapeName = ShapeName & " ' " & Shp.Name & " ' "
Next Shp

ShapeSelected = VBA.InputBox(ShapeName & " Please Input the Shape names in Inverted Comma", "Select Shape")

NewNameofShape = VBA.InputBox("Please enter new name of Shape you have selected", "Rename Shape")

If ShapeSelected = vbNullString Or NewNameofShape = vbNullString Then Exit Sub

WS.Shapes(ShapeSelected).Name = NewNameofShape

End Sub



Points to Remember

1. The First Inpubox will provide you the list of the Shape available in the Inverted Comma. You need to type the name in the input area which you want to rename is

2. A second input box will ask you to enter a new name.

and there you go.

Saturday, November 24, 2018

Fill ComboBox based on Seach Criteria

One the best approch for this requirement is to add one textbox as search bar which provides the same result you reuired.

Here we need to focus on three things. I'm cosidering that your combobox is in the userform1
and your students data list is in the sheet1.

Now,

There are two events you need configure to perform this task.

1. UserForm_Initialize
2. TextBox1_Change

and the one sub procedure which will populate the result based on the keyword in the textbox

3. Populate_Combobox

Now

Coding for the 1 & 2 is the same

Private Sub TextBox1_Change()
Populate_Combobox
End Sub

Private Sub UserForm_Initialize()
Populate_Combobox
End Sub

Now let's see the code for the Sub Procedure

Private Sub Populate_Combobox()
Dim I As Long
I = 2
Dim LenofStr As Long
LenofStr = 0
With UserForm1
.ComboBox1.Clear
If .TextBox1.Value = vbNullString Then
Do Until Sheet1.Cells(I, 1).Value = Empty
.ComboBox1.AddItem Sheet1.Cells(I, 1).Value
I = I + 1
Loop
Else
LenofStr = VBA.Len(.TextBox1.Value)
Do Until Sheet1.Cells(I, 1).Value = Empty
If VBA.Left(VBA.UCase(Sheet1.Cells(I, 1).Value), LenofStr) = VBA.UCase(.TextBox1.Value) Then
.ComboBox1.AddItem Sheet1.Cells(I, 1).Value
End If
I = I + 1
Loop
End If
End With
End Sub

I have also attached images with this post




IsValidPasswordString Function

'Following function will verify if the password string contains following characters or not? Rem : List of Characters Group - ASCII Rem ...