Showing posts with label Template. Show all posts
Showing posts with label Template. Show all posts

Sunday, November 13, 2022

VBA Methods - Workbook Add with Header

Excel.workbooks.add is to create new  Workbook with template.

Syntax : expression.Add (Template) , Returns : New Workbooks with template

Refer previous post for more details Here.

Below Example is to Create New Workbook with Header:

VBA Vode:

Option Explicit
Sub Examples_WorkBookAdd_WithHeader()
    Dim MstWB As Workbook
    Dim SumWs As Worksheet
    Dim StrHdr As String
    Dim j As Integer
    
    Set MstWB = Workbooks.Add(1)
    Set SumWs = MstWB.Sheets(1)
    SumWs.Name = "Summary"
    StrHdr = "No.,Date,Code,Stock Name,Open,Close,Qty"
    For j = LBound(Split(StrHdr, ",")) To UBound(Split(StrHdr, ","))
        SumWs.Cells(1, j + 1) = Split(StrHdr, ",")(j)
    Next j
    
    'You May Include any code project Here
    
    With SumWs
        .Rows(1).Font.Bold = True
        .Cells.EntireColumn.AutoFit
    End With
    
    Set MstWB = Nothing
    Set SumWs = Nothing
    StrHdr = ""

End Sub

Note: The Example we use Template XlWBATemplate which is equivalent to 1. 

Read more about Excel.workbooks.add, excelmacros, macro excel,
excel programming, excel vba at below links.

Microsoft Reference-Excel.workbooks.add
Other Reference-Excel.workbooks.add

Leave your comments if you have any request.
Practice makes perfect.
Thank You.

Sunday, October 16, 2022

Data type - Date and Time

Data type Date are stored as IEEE 64-bit (8-byte) ranging from 1 January 100, to 31 December 9999, and times from 0:00:00 to 23:59:59. The Date uses decimal numbers to represent the date and time together therefore our result must be declare as Double.

VBA Vode: (To get different date in Hours, Days, Months and Years)

Option Explicit
Sub Examples_DateDiffer()
    
    Dim DtNumA As Date, DtNumB As Date
    Dim DtNumHr As Long, DtNumDy As Long
    Dim DtNumMn As Long, DtNumYr As Integer
    
    DtNumA = "16-10-2022": DtNumB = "16-10-2021"
    If DtNumA - DtNumB > 0 Or DtNumA - DtNumB < 0 Then
        DtNumHr = DateDiff("H", DtNumB, DtNumA) 'Different in Hours
        DtNumDy = DateDiff("D", DtNumB, DtNumA) 'Different in Days
        DtNumMn = DateDiff("M", DtNumB, DtNumA) 'Different in Months
        DtNumYr = DateDiff("YYYY", DtNumB, DtNumA) 'Different in Years
    Else
        MsgBox "Sorry! Same date compare.TQ"
        Exit Sub
    End If
     
    Debug.Print "Hours: " & DtNumHr, "Days: " & DtNumDy, _
    "Months: " & DtNumMn, "Years: " & DtNumYr

End Sub

Answer: Hours: 8760   Days: 365     Months: 12    Years: 1

VBA Vode: (To get date after add Days, Months and Years)

Option Explicit
Sub Examples_DateAdded()
    
    Dim DtBefore As Date, DtAfterDy As Date
    Dim DtAfterMn As Date, DtAfterYr As Date
    
    DtBefore = DateValue("Oct 16, 2022")
    DtAfterDy = DateAdd("d", 3, DtBefore) 'Add 3 days after
    DtAfterMn = DateAdd("m", 3, DtBefore) 'Add 3 months after
    DtAfterYr = DateAdd("yyyy", 3, DtBefore) 'Add 3 years after
    
    Debug.Print "Add 3 Days: " & DtAfterDy, "Add 3 Months: " & _
    DtAfterMn, "Add 3 Years: " & DtAfterYr
    
End Sub

Answer: Add 3 Days: 19/10/2022      Add 3 Months: 16/1/2023     Add 3 Years: 16/10/2025

VBA Vode: (To get current date and time)

Option Explicit
Sub Examples_DateCurrent()

    Dim DtNowDef As Date, DtNowCst As String
    
    DtNowDef = Now() 'Default
    DtNowCst = VBA.Format(Now(), "mm.dd.yy hh:mm") 'Custom
    
    Debug.Print "Default: " & DtNowDef, "Custom: " & DtNowCst

End Sub

Answer: Default: 16/10/2022 9:55:07 PM            Custom: 10.16.22 21:55
(The answer base on my own time when run this code)

Note: 

To converts a string to time serial number we use TimeValue function. The time's serial number is a number between 0 and 1. For example, Afternoon (half day) is represented by 0.5.

Microsoft Reference-Date-data-type
Other Reference-Date-data-type

Practice makes perfect. Thank You.

macro enabled excel
excel macro
vba coding
vba code

Friday, October 7, 2022

Summary Operator Is, Like, Mod and Not in Excel VBA

Even though Operator Is, Like, Mod and Not totally different in comparison but sometime difficult to remember which one need to use. Here comparison table for reference.

No. Operator Logical
1 Is Compare two object reference variables.
2 Like Compare two strings.
3 Mod Divide two numbers and return only the remainder.
4 Not Perform logical negation on an expression.

Operator Commonly Use for
Is ObjectA Is ObjectB = TRUE/FALSE
Is MyRange Is Nothing = TRUE/FALSE
Is Intersect(MyRange,Selection) Is Nothing = TRUE/FALSE
Like String Like String Pattern(*,#,?,[!]) = TRUE/FALSE
Mod A=7,B=2, A Mod B = 1 (Balance for 2*3=6)
Not A=7,B=2. Not (A > B) = FALSE, Not (A < B) = TRUE

VBA Vode:

Option Explicit
Sub OperatorIsLikeModNot()
    
    Dim MySheet As Worksheet
    Dim iNumA As Integer, iNumB As Integer
    Dim StrUrlA As String, StrUrlB As String
    
    Dim MyRange As Range, MySelect As Range
    
    Set MySheet = ActiveSheet
    Set MyRange = MySheet.Range("A1:D20")
    Set MySelect = Selection
    StrUrlA = "https://mrvba.blogspot.com/"
    StrUrlB = "C:\Users\UserName\Desktop\AlQuran MP3"
    iNumA = 10: iNumB = 3
    
    'Combination Is and Not Operator
    If Not MySheet Is Nothing Then
        Debug.Print MySheet.Name
        'Combination Is Intersect and Not Operator
        If Not Intersect(MySelect, MyRange) Is Nothing Then
            Debug.Print "Your Selected cell is in range A1 to D20."
        Else
            Debug.Print "Your Selected cell is Not in range."
        End If
        'Operator Like
        If StrUrlA Like "https://*" Then
            Debug.Print "Yes! This is URL:" & StrUrlA
        Else
            Debug.Print "This is not Url:" & StrUrlB
        End If
        If StrUrlB Like "https://*" Then
            Debug.Print "Yes! This is URL:" & StrUrlA
        Else
            Debug.Print "This is not Url:" & StrUrlB
        End If
        'Operator Mode and And operator
        If IsNumeric(iNumA) And IsNumeric(iNumB) Then
            Debug.Print iNumA Mod iNumB
        End If
        'Operator Not
        If Not (iNumA > iNumB) Then
            Debug.Print "No: " & iNumA & " is Less than " & iNumB
        ElseIf Not (iNumA < iNumB) Then
            Debug.Print "Yes: " & iNumA & " is more than " & iNumB
        End If
    End If

End Sub

Note:
Most commonly use Operator among these is Not and Is, sometime only use like and seldom use Mod.

Microsoft Reference-Is-operator
Microsoft Reference-Like-operator
Microsoft Reference-Mod-operator
Microsoft Reference-Mod-operator example
Microsoft Reference-Not-operator

Practice makes perfect. Thank You.

excel training beginners
coding in vba
excel training online
visual basic for applications

The different between Operator Or, Xor, And, Eqv and Imp in Excel VBA

Sometime very hard to choose which Operator need use when we have 2 expressions or statements to compare because the result almost the same. Here we have table for reference.

No. Operator Logical
1 Or Disjunction
2 Xor Exclusion
3 And Conjunction
4 Eqv Equivalence
5 Imp Implication


Operator
No. If expression1 is And expression2 is Or Xor And Eqv Imp
1 True True True False True True True
2 True False True True False False False
3 True Null True Null Null Null Null
4 False True True True False False True
5 False False False False False True True
6 False Null Null Null False Null True
7 Null True True Null Null Null True
8 Null False Null Null False Null Null
9 Null Null Null Null Null Null Null

For more example refer below table and code.

VBA Vode:

Option Explicit
Sub ComparisonOperator_All()

    Dim i As Integer
    Dim myRng As Range, Cell As Range
    Dim iNum1, INum2, INum3, INum4
    With ActiveSheet
        i = 2
        Do
            If .Range("B" & i) = "" Then
                iNum1 = Null
            Else
                iNum1 = .Range("B" & i)
            End If
            If .Range("C" & i) = "" Then
                INum2 = Null
            Else
                INum2 = .Range("C" & i)
            End If
            If .Range("E" & i) = "" Then
                INum3 = Null
            Else
                INum3 = .Range("E" & i)
            End If
            If .Range("F" & i) = "" Then
                INum4 = Null
            Else
                INum4 = .Range("F" & i)
            End If
            
            .Range("D" & i) = iNum1 > INum2
            .Range("G" & i) = INum3 > INum4
            
            'Operator
            .Range("H" & i) = iNum1 > INum2 Or INum3 > INum4
            .Range("I" & i) = iNum1 > INum2 Xor INum3 > INum4
            .Range("J" & i) = iNum1 > INum2 And INum3 > INum4
            .Range("K" & i) = iNum1 > INum2 Eqv INum3 > INum4
            .Range("L" & i) = iNum1 > INum2 Imp INum3 > INum4
            
            i = i + 1
        Loop While .Range("A" & i) <> ""
    
        'To put background color base on result
        Set myRng = .Range("H2:L10")
        For Each Cell In myRng
            If Cell.Text = "TRUE" Then
                Cell.Interior.ColorIndex = 4 'Green
            ElseIf Cell.Text = "FALSE" Then
                Cell.Interior.ColorIndex = 6 'Yellow
            Else
                Cell.Interior.ColorIndex = 3 'Red
            End If
        Next
    End With
    
End Sub

Note:
The above code can be simplify with array in advanced topic. These operator commonly use with If...Then..Else function. Operator Or & And are the most commonly use.

Microsoft Reference-Or-operator
Microsoft Reference-Xor-operator
Microsoft Reference-And-operator
Microsoft Reference-Eqv-operator
Microsoft Reference-Imp-operator

Practice makes perfect. Thank You.

excelmacros
macro excel
excel programming
excel vba

Saturday, October 1, 2022

Comparison Operator Like in Excel VBA

 Comparison operator Like is for string versus pattern. The result after comparison is TRUE or FALSE, if TRUE then string matched with pattern and vice versa. Pattern consist character that represent certain condition as below. 

Character in Pattern Matches in string
* Nothing or Combination of any Characters.
# Any Single digit number.
? Any Single Character.
[] Any single character inside 2 characters ex: [A-Z]
[!] Any single character outside 2 Characters ex: [!A-Z]

Below example is from Microsoft Reference -Like Operator.


 Explanation:

No Result Explanation
1 True "a" before and after Matched, "BBB" Matched with "*"
2 True "F" Matched single Character within "[A-Z]"
3 False "F" Not matched other than Character within "[!A-Z]"
4 True "a" before and after Matched, "2" Matched with "#"
5 True "a" Matched, "M" Matched [L-P], "5" Matched "#", "b" Matched "[!c-e]"
6 True "B" Matched, "A" Matched "?", T Matched, "123khg" Matched with "*"
7 False "B" Not matched "C", "A" Matched "?", T Matched, "123khg" Matched with "*"
8 True "a" Matched, Nothing Matched with "*", "b" Matched
9 False "a" Not matched with "a ", "*" Matched "[*]", "b" Matched
10 False "a" Matched, "xxxxx" Not matched "[*]", "b" Matched
11 True "a " Matched, "[" Matched "[[]", "xyz" Matched "*"
12 Error :93 Incomplete pattern (Error 93)

VBA Code:

Option Explicit
Sub ComparisonOperator_Like()

    Dim i As Integer
    Dim StrText As String
    Dim StrPtrn As String
    Dim Cell As Range, MyRng As Range
    With ActiveSheet
        i = 2
        Do
            'Assign Variables
            StrText = .Range("B" & i)
            StrPtrn = .Range("C" & i)

            On Error Resume Next
            'Compare string and pattern with operator like
            .Range("D" & i) = StrText Like StrPtrn
            
            'Indicate Error Code if failed
            If Err.Number <> 0 Then
                .Range("D" & i) = "Error :" & Err.Number
            End If
            
            'Reset Variables
            Err.Clear
            StrText = "": StrPtrn = ""
            i = i + 1
        Loop While .Range("A" & i) <> ""
        
        'To put background color base on result
        Set MyRng = .Range("D2:D13")
        For Each Cell In MyRng
            If Cell.Text = "TRUE" Then
                Cell.Interior.ColorIndex = 4 'Green
            ElseIf Cell.Text = "FALSE" Then
                Cell.Interior.ColorIndex = 6 'Yellow
            Else
                Cell.Interior.ColorIndex = 3 'Red
            End If
        Next
    End With
    
End Sub

Practice makes perfect. Thank You.

Friday, September 23, 2022

Convert Excel Table into HTML table with VBA code

Actually to convert Excel table into HTML table is to use Save As web page either whole sheet or selection but we also can use VBA code below to convert by selecting table range example below and run the code. New pop up window will open notepad with HTML code inside and immediately can paste into your blog or webpage.


Run below code to get HTML code inside notepad.

VBA Code:

Option Explicit
Sub ToCreateTableForSelectedRange()
    Dim OpnShell As Variant
    Dim FSO, fs As Object
    Dim StrPath As String
    
    Dim iRow As Integer, iCol As Integer
    Dim Cell As Range, Rng As Range
    Dim i As Integer, j As Integer, k As Integer
    Dim l As Integer, x As Integer
    
    Dim DbWitdh() As Double, DbWitdhTot As Double
    Dim DbWitdhP() As String, DbWitdhAcc As Double
    Dim iColSp As Byte
    
    Dim Qto As String, ClEnd As String
    Dim BdOpn As String, BdCls As String
    Dim TdOpn As String, TdCls As String
    Dim TrOpn As String, TrCls As String
    Dim TblOpn As String, TblCls As String
    Dim StrStyle As String, StrTblWd As String
    Dim StrCellSp As String, StrCellPd As String
    Dim StrBdrCol As String, StrBdr As String
    Dim TBdOpn As String, TBdCls As String
    Dim StrCS As String, StrWd As String, StrAl As String
    
    Qto = """": ClEnd = ">"
    BdOpn = "<b>": BdCls = "</b>"
    TdOpn = "<td": TdCls = "</td>"
    TrOpn = "<tr>": TrCls = "</tr>"
    StrStyle = " style=" & Qto & "border-collapse: collapse;"
    StrTblWd = " width: 500px;" & Qto
    StrCellSp = " cellspacing=" & Qto & "0" & Qto
    StrCellPd = " cellpadding=" & Qto & "3" & Qto
    StrBdrCol = " bordercolor=" & Qto & "#000000" & Qto
    StrBdr = " border=" & Qto & "1" & Qto
    TblOpn = "<table" & StrStyle & StrTblWd & StrCellSp & _
    StrCellPd & StrBdrCol & StrBdr & ClEnd
    TblCls = "</table>"
    TBdOpn = "<tbody>": TBdCls = "</tbody>"
    StrCS = " colspan=" & Qto: StrWd = " width=" & Qto
    StrAl = " align=" & Qto & "Center" & Qto
    
    Set Rng = Selection
    If Rng.Rows.Count < 2 Or Rng.Columns.Count < 2 Then
        MsgBox "Please select range with table!": GoTo Line1
    End If
    
    'To Create new Text File
    StrPath = VBA.Environ("UserProfile") & "\Desktop\TableGenerator.txt"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    'To Check files existance and delete
    On Error Resume Next
    If Dir(StrPath) <> "" Then Kill StrPath
    
    k = 1
    For Each Cell In Rng
        If Cell.Row > iRow And iRow > 0 Then Exit For
        If iRow = 0 Then iRow = Cell.Row
        If iCol = 0 Then iCol = Cell.Column
        ReDim Preserve DbWitdh(k): DbWitdh(k) = Cell.ColumnWidth
        DbWitdhTot = DbWitdhTot + DbWitdh(k)
        iColSp = k
        k = k + 1
    Next

    For x = LBound(DbWitdh) + 1 To UBound(DbWitdh)
        ReDim Preserve DbWitdhP(x)
        If x < UBound(DbWitdh) Then
            DbWitdhP(x) = Round((DbWitdh(x) / DbWitdhTot) * 100, 0)
            DbWitdhAcc = DbWitdhAcc + DbWitdhP(x)
        Else
            DbWitdhP(x) = 100 - DbWitdhAcc
        End If
    Next x
    
    k = 1
    If Dir(StrPath) = "" Then
        Set fs = FSO.CreateTextFile(StrPath, 2)
        With fs
            .WriteLine TblOpn & TBdOpn
            For i = iRow To iRow + Rng.Rows.Count - 1
                l = 1
                .WriteLine TrOpn
                For j = iCol To iCol + iColSp - 1
                    If k = 1 Then
                        .WriteLine TdOpn & StrCS & iColSp & Qto & _
                        StrWd & DbWitdhP(l) & "%" & Qto & StrAl & _
                        ClEnd & BdOpn & Cells(i, j) & BdCls & TdCls
                    Else
                        .WriteLine TdOpn & StrCS & iColSp & Qto & _
                        StrWd & DbWitdhP(l) & "%" & Qto & StrAl & _
                        ClEnd & Cells(i, j) & TdCls
                    End If
                    l = l + 1
                Next j
                .WriteLine TrCls
                k = k + 1
            Next i
            .WriteLine TBdCls & TblCls
        End With
    End If
    
    'Just To Open NotePad Created
    If Err = 0 Then
        OpnShell = Shell("C:\Windows\System32\notepad.exe " & _
        StrPath, vbNormalFocus)
    End If
    On Error GoTo 0
    
Line1:
    'Reset Variables
    iRow = 0: iCol = 0
    Set Cell = Nothing: Set Rng = Nothing
    Erase DbWitdh: DbWitdhTot = 0
    Erase DbWitdhP: DbWitdhAcc = 0
    iColSp = 0
End Sub

The result in HTML as below:

No. Subject Score Grade
1 English 100
2 Mathematics 65
3 Science 30
4 Physics 55
5 History 20
6 Chemistry 48
7 Biology 70
8 Geography 90

Practice makes perfect. Thank You.

Tuesday, September 13, 2022

To Protect and Unprotect Sheet with VBA Code

To protect worksheet from editing. 

  • Go to Review Tab and click at Protect Sheet.

  • Under Protect Sheet Key in Password and Tick allow user to do and click OK.

  • Key in password to reconfirm and click OK.


  • Done.

VBA code:

Option Explicit
Sub ProtectSheet()
    
    If ActiveSheet.ProtectContents = False Then
        With ActiveSheet
            .Protect Password:="abc123", AllowInsertingRows:=True, _
             AllowDeletingRows:=True, Contents:=True, _
             AllowFiltering:=True, Scenarios:=True
            .EnableSelection = xlUnlockedCells
        End With
    End If
    
End Sub

To Unprotect worksheet. 

  • Go to Review Tab and click at Unprotect Sheet.

  • Key in password and click OK.

  • Done.

VBA code:

Option Explicit
Sub UnprotectSheet()
    
    If ActiveSheet.ProtectContents = True Then
        ActiveSheet.Unprotect Password:="abc123"
    End If
    
End Sub

Microsoft Reference - Protect Worksheet

Practice makes perfect. Thank You.

Monday, September 12, 2022

To Add Hyperlink Formula and VBA code

Hyperlink in Microsoft Excel is to create link to any location example URL, Drive, Range, Cells or etc.


Formula = HYPERLINK(link_location,friendly_name).

  • link_location is https://mrvba.blogspot.com/
  • friendly_name is Visual Basic For Application.

VBA code:

Option Explicit
Sub InsertingHyperlink()

    With ActiveSheet
        'a) Insert with formula
        .Range("A1").Formula = "=HYPERLINK(""http://mrvba.blogspot.com"",""Visual Basic for Application"")"
        
        'b) Simple Link direct URL
        .Hyperlinks.Add Range("A2"), "http://mrvba.blogspot.com"
        
        'c) With Anchor Text and Screen Tips
        .Hyperlinks.Add Range("A3"), "http://mrvba.blogspot.com", , "To learn VBA", "Click here"
        
        'd) With details Anchor Text and Screen Tips
        .Hyperlinks.Add Anchor:=Range("A4"), Address:="http://mrvba.blogspot.com", _
        SubAddress:="", ScreenTip:="To learn VBA", TextToDisplay:="Click Here"
    End With

End Sub

Microsoft Reference - Hyperlink Method

Done.

Sunday, September 11, 2022

To Use Hlookup with formula and VBA code

Hlookup formula in Microsoft Excel is to find something in table or range by columns. In this example we refer to table monthly score in Sheet1.


Table in Sheet1: Base on monthly we need to find score in

  • Range("B2:M3)
  • Row index = 2

Formula = HLOOKUP(lookup_value,table_array,row_index_num,range_lookup).

In Sheet2 we have another table without score, now we have to lookup this value from Sheet1 table by using formula.


Fill this formula into Range("C2") = HLOOKUP(B2,Sheet1!$B$2:$M$3,2,FALSE).
  • B2 is lookup_value
  • Sheet1!$B$2:$M$3 is table_array but $ sign to fix the table when drag down.
  • 2 is row_index_num
  • FALSE is range_lookup (FALSE - Exact Match, TRUE - Approximate match)

VBA code:

Option Explicit
Sub HLookUPExample()

    Dim i As Integer
    With ActiveSheet
        i = 2
        Do
            .Range("C" & i) = Application.HLookup(.Range("B" & i), ActiveWorkbook.Sheets("Sheet3").Range("$B$2:$M$3"), 2, False)
        i = i + 1
        Loop While .Range("A" & i) <> ""
    End With
    
End Sub
Note:
  • Make sure Sheet2 is selected or activated.
  • If your table is located in another workbook then change ActiveWorkbook to Workbooks("MyBookName.xls") but ensure this workbook is open.

Microsoft Reference - Hlookup function

Done.

Saturday, September 10, 2022

To Use Vlookup with formula and VBA code

Vlookup formula in Microsoft Excel is to find something in table or range by rows. In this example we refer to table monthly score in Sheet1.

Table in Sheet1 and range = Range("B2:C13)  and base on month we need to find score in column index = 2. 

Formula = VLOOKUP(lookup_value,table_array,col_index_num,range_lookup).

In Sheet2 we have another table without score, now we have to lookup this value from Sheet1 table by using formula.

Fill this formula into Range("C2") = VLOOKUP(B2,Sheet1!$B$2:$C$13,2,FALSE).
  • B2 is lookup_value
  • Sheet1!$B$2:$C$13 is table_array but $ sign to fix the table when drag down.
  • 2 is column_index_num
  • FALSE is range_lookup (FALSE - Exact Match, TRUE - Approximate match)

VBA code:

Option Explicit
Sub VLookUPExample()

    Dim i As Integer
    With ActiveSheet
        i = 2
        Do
            .Range("C" & i) = Application.VLookup(.Range("B" & i), ActiveWorkbook.Sheets("Sheet1").Range("$B$2:$C$13"), 2, False)
        i = i + 1
        Loop While .Range("A" & i) <> ""
    End With
    
End Sub
Note:
  • Make sure Sheet2 is selected or activated.
  • If your table is located in another workbook then change ActiveWorkbook to Workbooks("MyBookName.xls") but ensure this workbook is open.

Microsoft Reference - Vlookup function

Done.

Wednesday, September 7, 2022

To Go Specific Cells or Range

Below code to is To Go Specific Cells and can be use to scroll any direction.

Option Explicit
Sub ToGoSpecficCells()

    Application.Goto ActiveSheet.Range("A1"), True
    
End Sub

Note: Change cells location in bracket A1-> any cell and Go cells or range will be at top left corner of excel sheet.

To Scroll up entire rows and Scroll left entire columns

Below code to is To Scroll up entire rows and Scroll left entire columns.

Option Explicit
Sub ToScrollUPcompletely()

    With ActiveWindow
        .ScrollColumn = 1
        .ScrollRow = 1
    End With
    
End Sub

Note: Wherever your location in excel sheet it will return to top left.

To Sort Data Ascending Or Descending without Header

Below code to sort data with header ascending or descending. For example data with 3 columns.

Option Explicit
Sub ToSortWithOutHeader()

    Range("A2:C6").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, _
    Key2:=Range("B2"), Order2:=xlAscending, _
    Key3:=Range("C2"), Order3:=xlAscending, _
    Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
    DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
    Range("A1").Select
    
End Sub

Note: Selection must include header and for Descending just change xlAscending to xlDescending.

To Sort Data Ascending Or Descending with Header

Below code to sort data with header ascending or descending. For example data with 3 columns.

Option Explicit
Sub ToSortWithHeader()

    Columns("A:C").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, _
    Key2:=Range("B2"), Order2:=xlAscending, _
    Key3:=Range("C2"), Order3:=xlAscending, _
    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
    DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
    Range("A1").Select
    
End Sub

Note: Selection must include header and for Descending just change xlAscending to xlDescending.

Tuesday, August 2, 2022

How to Get a List of Folders and Files Name from Selected Folder with VBA

 To compared files inside between folders it will be much easier if we have a list of folders and files name inside folder 1 and folder 2 in excel sheet then we can use formula true and false  or VLOOKUP function. To get the list we can use VBA code below:

Option Explicit
Sub GetFordersAndFilesNameInSelectedFolder()
    Dim pPath As String
    Dim FileName As String
    Dim MstWB As Workbook, MstWS As Worksheet
    Dim i As Integer
    
    'Open Dialog Box To Select Folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo Line1
        pPath = .SelectedItems(1)
    End With
    
    'To ensure path end with slash
    If Right(pPath, 1) <> "\" Then
        pPath = pPath & "\"
    End If
    
    'Assign Filename string
    FileName = Dir(pPath, vbDirectory)
    
    'Create New Workbook with normal template
    Set MstWB = Workbooks.Add(1)
    Set MstWS = MstWB.ActiveSheet
    
    'Create Header
    MstWS.Range("A1") = "No."
    MstWS.Range("B1") = "Name"
    
    'Start Row to fill in
    i = 2
    
    'Loop To Get All File and Folrder name inside the folder
    Do While FileName <> ""
        If Left(FileName, 1) <> "." Then
            MstWS.Range("A" & i) = i - 1
            MstWS.Range("B" & i) = FileName
            i = i + 1
        End If
        FileName = Dir()
    Loop
    
    'Formatting
    MstWB.Activate
    MstWS.Rows(1).Font.Bold = True
    MstWS.Cells.EntireColumn.AutoFit
    MstWS.Cells.HorizontalAlignment = xlLeft
    ActiveWindow.WindowState = xlMaximized
    
Line1:
    
    'Clear Variables
    Set MstWB = Nothing
    Set MstWS = Nothing
    FileName = "": pPath = ""
End Sub

To use this code:

  • Copy this and paste into module and Run this code
  • Select any single folder
  • New workbook will be created
  • All folders and files name will be listed in Sheet1

Please try and give us feedback.Thanks You