Thursday, 17 July 2014

How to Pull out Last available String or Number from a Range

How to Pull out Last available String from Strings Data or Number from Numbers Data Range
Scenario-I :
Suppose there is list of Strings in the Range A3:F3 , In that Case if you want to Pull out Last String Value used in the Range , You can try the Following Formulas , also refer in below image for better understanding :

Case-I :Range of Strings with Continuous Occurrence :

 =INDEX(A3:F3,0,COUNTA(A3:F3))

Case-II :Range of Strings with Random Occurrence :


 =INDEX(A10:F10,MATCH("",A10:F10, -1))

Scenario-II :
Suppose there is list of Numbers in the Range A3:F3 , In that Case if you want to Pull out Last Number Value used in the Range , You can try the Following Formulas , also refer in below image for better understanding :

Case-I :Range of Numbers with Continuous Occurrence :

 =INDEX(A15:F15,0,COUNTA(A15:F15))

Case-II :Range of Numbers with Random Occurrence :

=INDEX(A22:F22,0,MATCH(-123456789,A22:F22, -1))


Thanks.,
TAMATAM
       [ BI-Analyst ]

Excel String Functions - LEFT,RIGHT and Mid Functions

LEFT , RIGHT , MID Combo Functions :
Let us Suppose there is a String as below , from that if you want Pull out Substring of Your Desire ,Please look into Below STRING Combo Formulas::

String :
Contact_Us@We@Tamatam.in

LEFT Combo Formula :
From the below String If you want to Retrieve the Substring whatever before “_” , you can Retrieve by using the following formula :

String :
Contact_Us@We@Tamatam.in


Formula :
=LEFT(A2,FIND("_",A2)-1)

Result :
Contact

RIGHT Combo Formula :
From the below String If you want to Retrieve the Substring whatever after second “@” , you can Retrieve by using the following formula :

String :Contact_Us@We@Tamatam.in


Formula :
=RIGHT(A2,LEN(A2)-FIND("@",A2,FIND("@",A2)+1))

Result :
Tamatam.in

MID Combo Formula :
From the below String If you want to Retrieve the Substring whatever in the Middle of “_” and second ‘@” , you can Retrieve by using the following formula :

String :
Contact_Us@We@Tamatam.in

Formula :
=MID(A2,FIND("_",A2)+1,LEN(A2)-(FIND("_",A2)+1+LEN(RIGHT(A2,LEN(A2)-FIND("@",A2,FIND("@",A2)+1)))))

Result :
Us@We







Please come back with you valuable questions on the above Combo Formulas.

Wednesday, 16 July 2014

How to List or Fetch all the Details of Files and SubFolders From a Specific Path Using Excel VBA Macro

Macro to List or Fetch all the Details of  Files and SubFolders with Files from a Folder or Specific Path

Sub List_All_SubFolders_Files()
    Dim SrcPath As String       
    Dim FSO As Object
   
    Dim SrcFolder As Object
    Dim S_Folder As Object
    Dim S_File As Object
    
    Dim FileExt As String
    Dim WS As Object
    
     
    SrcPath = ActiveSheet.Range("B1").Value
    Set WS = ThisWorkbook.ActiveSheet
        
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SrcFolder = FSO.GetFolder(SrcPath)

    If Right(SrcPath, 1) = "\" Then
        SrcPath = Left(SrcPath, Len(SrcPath) - 1)
    End If
    
    If (SrcFolder.Files.Count = 0) And (SrcFolder.SubFolders.Count = 0) Then
        MsgBox "Src Folder Doesnot Have Any Subfolders/Files", vbOKCancel, "Src                               Folder Is Empty"
        Exit Sub
    End If

    ActiveSheet.Range("A3:G1000").Select
    Selection.Clear

    Z = 0
    K = 3

    MFC = SrcFolder.Files.Count 'Main Folder Files Count
    
        WS.Cells(K, 1) = SrcFolder.Name
        WS.Cells(K, 1).Interior.ColorIndex = 37
        WS.Cells(K, 1).Font.Bold = True
        WS.Cells(K, 2) = SrcFolder.Path
        WS.Cells(K, 3) = Round(SrcFolder.Size / 1024) & " KB"
        WS.Cells(K, 4) = SrcFolder.Type
        WS.Cells(K, 5) = SrcFolder.DateLastModified
        WS.Cells(K, 6).Select
        WS.Hyperlinks.Add Anchor:=Selection, Address:= _
                SrcFolder.Path, TextToDisplay:="Click Here to Open"
        
    If (Round((SrcFolder.Size / 1024) / 1024) = 0) Then
        WS.Cells(K, 7) = "<1 MB"
    Else
        WS.Cells(K, 7) = Round((SrcFolder.Size / 1024) / 1024) & " MB"
    End If
    K = K + 1

For Y = K To MFC
    For Each File In SrcFolder.Files
    
        M_File_Name = File.Name
        M_File_Path = File.Path
        M_File_Size = Round(File.Size / 1024) & " KB"
        
            If (Round((File.Size / 1024) / 1024) = 0) Then
                MB_File_Size = "<1 MB"
            Else
               MB_File_Size = Round((File.Size / 1024) / 1024) & " MB"
            End If
    
        M_File_Type = File.Type
        M_File_Modified = File.DateLastModified
        
        WS.Cells(Y, 1) = M_File_Name
        WS.Cells(Y, 2) = M_File_Path
        WS.Cells(Y, 3) = M_File_Size
        WS.Cells(Y, 4) = M_File_Type
        WS.Cells(Y, 5) = M_File_Modified
        WS.Cells(Y, 6).Select
        WS.Hyperlinks.Add Anchor:=Selection, Address:= _
                M_File_Path, TextToDisplay:="Click Here to Open"
        WS.Cells(Y, 7) = MB_File_Size
        Y = Y + 1
        Z = Z + 1
    
    Next File
Next Y

K = K + Z

If (SrcFolder.SubFolders.Count > 0) Then

    For Each SubFolder In SrcFolder.SubFolders
    If (SubFolder.Files.Count > 0) Then
    
            S_Folder_Name = SubFolder.Name
            S_Folder_Path = SubFolder.Path
            S_Folder_Size = Round(SubFolder.Size / 1024) & " KB"
            
                If (Round((SubFolder.Size / 1024) / 1024) = 0) Then
                    SMB_Folder_Size = "<1 MB"
                Else
                    SMB_Folder_Size = Round((SubFolder.Size / 1024) / 1024) & " MB"
                End If
            
            S_Folder_Type = SubFolder.Type
            S_Folder_Modified = SubFolder.DateLastModified
            
            SFC = SubFolder.Files.Count ' Sub Folder Files Count
        
        For X = K To (K + SFC)
        
            WS.Cells(X, 1) = S_Folder_Name
            WS.Cells(X, 1).Interior.ColorIndex = 36
            
            WS.Cells(X, 1).Font.Bold = True
            WS.Cells(X, 2) = S_Folder_Path
            WS.Cells(X, 3) = S_Folder_Size
            WS.Cells(X, 4) = S_Folder_Type
            WS.Cells(X, 5) = S_Folder_Modified
            WS.Cells(X, 6).Select
            WS.Hyperlinks.Add Anchor:=Selection, Address:= _
                    S_Folder_Path, TextToDisplay:="Click Here to Open"
            WS.Cells(X, 7) = SMB_Folder_Size
       
            For Each File In SubFolder.Files
                X = X + 1
                S_File_Name = File.Name
                S_File_Path = File.Path
                S_File_Size = Round(File.Size / 1024) & " KB"
                
                        If (Round((File.Size / 1024) / 1024) = 0) Then
                            SMB_File_Size = "<1 MB"
                        Else
                           SMB_File_Size = Round((File.Size / 1024) / 1024) & " MB"
                        End If
            
                S_File_Type = File.Type
                S_File_Modified = File.DateLastModified
                
                WS.Cells(X, 1) = S_File_Name
                WS.Cells(X, 2) = S_File_Path
                WS.Cells(X, 3) = S_File_Size
                WS.Cells(X, 4) = S_File_Type
                WS.Cells(X, 5) = S_File_Modified
                WS.Cells(X, 6).Select
                WS.Hyperlinks.Add Anchor:=Selection, Address:= _
                        S_File_Path, TextToDisplay:="Click Here to Open"
                WS.Cells(X, 7) = SMB_File_Size
            
                K = K + 1
            Next File

            K = K + 1
        Next X

    End If
    Next SubFolder
End If

Set FSO = Nothing

End Sub



Thanks.,

TAMATAM
        [ BI-Analyst]

Saturday, 12 July 2014

How to Create Dynamic Dependent Dropdown List with Custom Data Validation

Excel Dynamic Dependent Dropdown List with Custom Data Validation
Let us suppose we have Months in the Colum A (A1:A13).Now, by using the Custom Drop Down Technique , we can display the Month Names in the drop down list(Dependent list) under each Quarter  that you selected (Q1_,Q2_,Q3_..) from the Independent Drop Down List.


This is a Most Useful Technique , in real time Data Analysis scenario.


Example :
First Define Range Names for the Data Items(Months)  as below :
Range A2:A4(Jan,Feb,Mar) as Q1_ , A5:A7(Apr,May,Jun) as Q2_……….Etc.




Next Define a Independent Dropdown in your desired Cell(Ex : D2) with Values as Q1_,Q2_,Q3_


Next right to the Quarter Dropdown Cell (E2) , where you want to display the Months List , define the following Custom Data Validation/Custom Drop Down as shown below :




Now you can see the Months list ( Dependent List ) for each Quarter (Independent List) that you selected as shown below :



Thanks
TAMATAM

Friday, 11 July 2014

How to Select Used Range Excluding Headers in Excel using VBA Macro

Excel VBA Macro to Select Used Range Excluding Headers
Sub Used_Rows_Columns_Range()
Dim RC As Long
Dim CC As Long
Dim Sort_Range As String

'To Get  Count of Columns and Rows with data in Used Range(Eg: 1,2,3)
RC = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

CC = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

' To Get Column Index Name in Used Range(Eg: A,B,C..)

CN = Split(Cells(, CC).Address, "$")(1)

Data_Range = "$A$2" & " : " & "$" & CN & "$" & RC

ActiveSheet.Range(Data_Range).Select


End Sub

Example :



Other References for Dynamic Used Range :

How to Select Dynamic Actual Used Range in Excel


Sunday, 6 July 2014

Excel VBA Macro to Store Each Sheet Name in an Array

Macro to Store Each Sheet Name in an Array
Sub ShtNamesIntoArray()

Dim SheetNames() As String
ReDim SheetNames(1 To ActiveWorkbook.Sheets.Count) ' Resizing Array

For X = 1 To Sheets.Count
SheetNames(X) = Sheets(X).Name
Next X

'To display the sheet name First Column of Active Sheet
For X = 1 To Sheets.Count
ActiveSheet.Cells(X, 1) = SheetNames(X)
Next X

End Sub

To Understand More about Arrays , go through the below Links :






Saturday, 5 July 2014

Macro to Sort one Specific Column in Ascending and another Specific Column in Descending then give Rank in another Specific Column

Macro to Sort one Specific Column in Ascending and another Specific Column in Descending then give Rank in another Specific Column
Model - I :
Sub Sort_Ascend_Descend_Rank()
Dim RC As Long
Dim CC As Long
Dim Sort_Range As String

'To Get Column Index Number in Used Range(Eg: 1,2,3)
RC = ActiveSheet.UsedRange.Rows.Count
CC = ActiveSheet.UsedRange.Columns.Count 

' To Get Column Index Name in Used Range(Eg: A,B,C..)
CN = Split(Cells(, CC).Address, "$")(1) 


Sort_Range = "$A$1" & " : " & "$" & CN & "$" & RC

For X = 1 To CC
If ActiveSheet.Cells(1, X) = "Product Id" Then
S_1 = Cells(1, X).Column '? Sorting Column-1 Number(Eg: 1,2,3)
SC_1 = Split(Cells(, S_1).Address, "$")(1) '? Sorting Column-1 Index Name(Eg: A,B,C..)

ElseIf ActiveSheet.Cells(1, X) = "Sample" Then
S_2 = Cells(1, X).Column '? Sorting Column-2 Index Number(Eg: 1,2,3)
SC_2 = Split(Cells(, S_2).Address, "$")(1) '? Sorting Column-2 Index Name(Eg: A,B,C..)

ElseIf ActiveSheet.Cells(1, X) = "Rank" Then
RNK_C = Cells(1, X).Column '? Ranking Column Index Number(Eg: 1,2,3)
RNK_CN = Split(Cells(, S_2).Address, "$")(1) '? Ranking Column Index Name(Eg: A,B,C..)

End If
Next X

SC1_Range = "$" & SC_1 & "$1" & " : " & "$" & SC_1 & "$" & RC
SC2_Range = "$" & SC_2 & "$1" & " : " & "$" & SC_2 & "$" & RC

ActiveSheet.Range(Sort_Range).Select

ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range(SC1_Range), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

ActiveSheet.Sort.SortFields.Add Key:=Range(SC2_Range), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    
    With ActiveSheet.Sort
        .SetRange Range(Sort_Range)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

X = 0
Y = 0
Z = 0
K = 0

For X = 2 To RC 'Total Rows in Used Range

For Y = X To RC

If Cells(Y, S_1) <> Cells(X, S_1) Then Exit For

If (Cells(Y - 1, S_2) <> Cells(Y, S_2)) Then
Z = (Z + 1)
Cells(Y, RNK_C) = Z
K = K + 1

ElseIf (Cells(Y - 1, S_1) = Cells(Y, S_1)) And (Cells(Y - 1, S_2) = Cells(Y, S_2)) Then
Cells(Y, RNK_C) = Z
K = K + 1

Else
Z = Z + 1
Cells(Y, RNK_C) = Z
K = K + 1

End If
Next Y

X = (X + K) - 1
Z = 0
K = 0
Next X

ActiveSheet.Range("$A$1").Select
MsgBox "Job Over", vbOKOnly, "Done"

End Sub
----------------------------------------------------------------------------------------
Model - II :

Sub Sort_Ascend_Descend_Rank()

Dim RC As Long
Dim CC As Long
Dim Sort_Range As String

On Error Resume Next

RC = ActiveSheet.UsedRange.Rows.Count
CC = ActiveSheet.UsedRange.Columns.Count 'To Get Column Index Number in Used Range
CN = Split(Cells(, CC).Address, "$")(1) ' To Get Column Index Name in Used Range

Sort_Range = "$A$1" & " : " & "$" & CN & "$" & RC

'Loop to Convert Each Column As a Named Range with Heading Name

For X = 1 To CC 
If ActiveSheet.Cells(1, X) <> "" Then ActiveSheet.Cells(1, X).EntireColumn.Select
Selection.Name = Cells(1, X).Value
Next X

S_1 = ActiveSheet.Range("Gs_Id").Column ' ? Sorting Column-2 Number ?
S_2 = ActiveSheet.Range("Payout_Weight").Column ' ? Sorting Column-2 Number ?
RNK_C = ActiveSheet.Range("Rank").Column 'Ranking Column Number

ActiveSheet.Range(Sort_Range).Select

ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("Gs_Id"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

ActiveSheet.Sort.SortFields.Add Key:=Range("Payout_Weight"), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    
    With ActiveSheet.Sort
        .SetRange Range(Sort_Range)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

X = 0
Y = 0
Z = 0
K = 0

For X = 2 To RC 'Total Rows in Used Range

For Y = X To RC
If Cells(Y, S_1) <> Cells(X, S_1) Then Exit For

If (Cells(Y - 1, S_2) <> Cells(Y, S_2)) Then
Z = (Z + 1)
Cells(Y, RNK_C) = Z
K = K + 1

ElseIf (Cells(Y - 1, S_1) = Cells(Y, S_1)) And (Cells(Y - 1, S_2) = Cells(Y, S_2)) Then
Cells(Y, RNK_C) = Z
K = K + 1

Else
Z = Z + 1
Cells(Y, RNK_C) = Z
K = K + 1

End If
Next Y

X = (X + K) - 1
Z = 0
K = 0
Next X

ActiveSheet.Range("$A$1").Select
MsgBox "Job Over", vbOKOnly, "Done"

End Sub

Wednesday, 2 July 2014

How to Find Count or Sum of Sub Totals and Grand Totals Based on Cell Color Index Number in Excel

Macro to Find Count or Sum of Sub-Sub Totals and Grand Totals Based on Cell Color Index Number

Sub Grand_Sub_Totals_Count()

X = 0
Z = 0
K = 0

CC = InputBox("Please Enter Column In Which You Want to Find Counts" & vbNewLine _
& "Eg: 1 , 2 , 3 ...", "Please Enter Counting Column Number")

If CC = vbNullString Then Exit Sub

CC = Val(CC) 'Converting String Input to a Number Value


For A = 1 To 2500 'Records/Rows Range

"Put '1' in Each Cell of the Counting Column then Run Macro"
"Color-I Criteria :"

If (ActiveSheet.Cells(A, CC) = 1) And (ActiveSheet.Cells(A, CC).Interior.ColorIndex = -4142) Then
X = X + 1 ' Adding Sub-Sub Totals

"Color-II Criteria :"
ElseIf (ActiveSheet.Cells(A, CC).Interior.ColorIndex = 35) Then

ActiveSheet.Cells(A, CC).Value = X
Z = Z + X ' Adding Sub Totals

X = 0
End If

"Color-III Criteria :"
If (ActiveSheet.Cells(A, CC).Interior.ColorIndex = 43) Then

ActiveSheet.Cells(A, CC).Value = Z
K = K + Z ' Adding Grand Totals

Z = 0
End If

If (ActiveSheet.Cells(A, CC).Interior.ColorIndex = 14) Then

ActiveSheet.Cells(A, CC).Value = K

K = 0
End If

Next A

End Sub

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts