Loop

Option Explicit

'Endless do loop

Sub TestDoLoop()

    Range("a1").Select
  Do
    ActiveCell.Offset(1, 0).Select
  Loop
 
End Sub

'Do until active cell is not blank
Sub TestDoUntil()

Range("a1").Select

    Do Until ActiveCell.value = ""
    ActiveCell.Offset(1, 0).Select
    Loop
   
End Sub
'Loop until active cell is not blank
Sub TestLoopUntil()
 
   Range(Range("a1"), Range("a1").End(xlToRight)).Copy Range("a17")
   Range("c2").Select
   
    Do
        If ActiveCell.value = "Male" Then
            Range("a" & ActiveCell.Row, ActiveCell.End(xlToRight)).Copy _
                Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
       
    ActiveCell.Offset(1, 0).Select
   
    Loop Until ActiveCell.value = ""
   
End Sub

'Do While active cell is not blank
Sub TestDoWhile()
   Range(Range("a1"), Range("a1").End(xlToRight)).Copy Range("a17")
   Range("c2").Select
   
    Do While Not ActiveCell.value = ""
        If ActiveCell.value = "Male" Then
            Range("a" & ActiveCell.Row, ActiveCell.End(xlToRight)).Copy _
                Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
    ActiveCell.Offset(1, 0).Select

    Loop
   
End Sub

'Loop While active cell is not blank
Sub TestLoopWhile()
Range(Range("a1"), Range("a1").End(xlToRight)).Copy Range("a17")
Range("c2").Select

Do
        If ActiveCell.value = "Male" Then
            Range("a" & ActiveCell.Row, ActiveCell.End(xlToRight)).Copy _
                Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
    ActiveCell.Offset(1, 0).Select

Loop While Not ActiveCell.value = ""

End Sub

Array

'Declaring Arrays
'
'Arrays are declared the same way as other variables, using the Dim, Static, Private, or Public statements. The difference between scalar variables (those that aren't arrays) and array variables is that you generally must specify the size of the array. An array whose size is specified is a fixed-size array. An array whose size can be changed while a program is running is a dynamic array.
'
'Whether an array is indexed from 0 or 1 depends on the setting of the Option Base statement. If Option Base 1 is not specified, all array indexes begin at zero.
'
'Declaring a Fixed Array
'In the following line of code, a fixed-size array is declared as an Integer array having 11 rows and 11 columns:

'Using Arrays
'
'You can declare an array to work with a set of values of the same data type. An array is a single variable with many compartments to store values, while a typical variable has only one storage compartment in which it can store only one value. Refer to the array as a whole when you want to refer to all the values it holds, or you can refer to its individual elements.
'
'For example, to store daily expenses for each day of the year, you can declare one array variable with 365 elements, rather than declaring 365 variables. Each element in an array contains one value. The following statement declares the array variable
'
'curExpense
'
'with 365 elements. By default, an array is indexed beginning with zero, so the upper bound of the array is 364 rather than 365.
'
'Dim curExpense(364) As Currency


Option Explicit

'1. Write a VBA code to display months in array format from Jan-Dec.
Sub ArrayExp()

Dim i As Integer
Dim months_array(12) As String

    For i = 1 To 12
        months_array(i) = Sheets("Arrays").Cells(i, 1)
        MsgBox months_array(i)
    Next
   
End Sub

'2. Fixed Array to store value and place it to respective destination
Sub FixedSizeArray()

Dim testname(1 To 3) As String
Sheets("Arrays").Activate
   
    testname(1) = Range("a1").value
    testname(2) = Range("a2").value
    testname(3) = Range("a3").value
   
    Range("b1").value = testname(1)
    Range("b2").value = testname(2)
    Range("b3").value = testname(3)

Erase testname

End Sub
'3. Loopover Array to demonstrate storing values in array through FOR loop
Sub LoopOverArray()

Dim topnames(1 To 13) As String
Dim counter As Integer

Sheet5.Activate
    For counter = LBound(topnames) To UBound(topnames)
        topnames(counter) = Range("c" & counter + 1).value
    Next
         Range("d2").Select
 
    For counter = UBound(topnames) To LBound(topnames) Step -1
        ActiveCell.value = topnames(counter)
        ActiveCell.Offset(1, 0).Select
    Next
 Erase topnames

End Sub
'4. Example of multidimentional array to store 2 dimention array
Sub MultiDimensionArray()

Dim topname(0 To 9, 0 To 6) As Variant
Dim dimension1 As Integer, dimension2 As Integer
Sheet5.Activate

For dimension1 = LBound(topname, 1) To UBound(topname, 1)
    For dimension2 = LBound(topname, 2) To UBound(topname, 2)
        topname(dimension1, dimension2) = Range("e2").Offset(dimension1, _
            dimension2).value
    Next dimension2
Next dimension1

Range("m2").Select

For dimension1 = LBound(topname, 1) To UBound(topname, 1)
    For dimension2 = LBound(topname, 2) To UBound(topname, 2)
       ActiveCell.Offset(dimension1, dimension2).value = topname(dimension1, dimension2)
    Next dimension2
Next dimension1

Erase topname

End Sub
'5. Example of dynamic multi dimention array where rows and columns are flexible according to data
Sub DynamicMultiDimensionArray()

Dim topname() As Variant
Dim dimension1 As Integer, dimension2 As Integer

dimension1 = Range("a17", Range("a17").End(xlDown)).Cells.Count - 1
dimension2 = Range("a17", Range("a17").End(xlToRight)).Cells.Count - 1

ReDim topname(0 To dimension1, 0 To dimension2)
Sheet5.Activate

For dimension1 = LBound(topname, 1) To UBound(topname, 1)
    For dimension2 = LBound(topname, 2) To UBound(topname, 2)
        topname(dimension1, dimension2) = Range("a17").Offset(dimension1, dimension2).value
    Next dimension2
Next dimension1

Range("m17").Select

For dimension1 = LBound(topname, 1) To UBound(topname, 1)
    For dimension2 = LBound(topname, 2) To UBound(topname, 2)
       ActiveCell.Offset(dimension1, dimension2).value = topname(dimension1, dimension2)
    Next dimension2
Next dimension1

Erase topname

End Sub
'6. Storing array directly from the range and pasting it at destination
Sub QuickDynamicMultiDimensionArray()

Dim topname() As Variant
Sheet5.Activate

topname = Range("a31", Range("a31").End(xlDown).End(xlToRight))
Range("m31").Select


Range(ActiveCell, ActiveCell.Offset(UBound(topname, 1) - 1, UBound(topname, 2) - 1)).value = topname

Erase topname

End Sub

'7. Store calculation in array and paste it at destination
Sub CalculateWithArray()

Dim testheight() As Variant
Dim answers() As Variant
Dim counter As Long, dimension1 As Long

Sheet5.Activate

testheight = Range("B46", Range("B46").End(xlDown))
dimension1 = UBound(testheight, 1)

ReDim answers(1 To dimension1, 1 To 2)

For counter = 1 To dimension1
    answers(counter, 1) = Int(testheight(counter, 1) / 60)
    answers(counter, 2) = testheight(counter, 1) Mod 60
Next counter

Range("c46", Range("c46").Offset(dimension1 - 1, 1)).value = answers

Erase testheight
Erase answers

End Sub

Convert data from Excel to Text file with comma delimitted

Option Explicit

'Macro to convert excel file into text file

Sub ExcelToTextTransfer2()

Dim fso As New FileSystemObject
Dim TextFile As TextStream
Dim i, j, mnth As Long
Dim rng, c As Range

'------------Phase I

For mnth = 1 To 12              'Loop for month

    ActiveSheet.AutoFilterMode = False           'Remove existing filter
    Sheet1.Range("A1").AutoFilter field:=4, Criteria1:=Left(MonthName(mnth), 3)    'Autofilter on month on month

'------------Phase II

    Set TextFile = fso.CreateTextFile("C:\Users\Vinay Kumar\Desktop\VBA Classs\01 Apr\" _
                        & Left(MonthName(mnth), 3) & ".txt") 'Creation of text file
 
'------------Phase III
    Set rng = Range(Range("A1"), Range("A1").End(xlDown)).SpecialCells(xlCellTypeVisible)       'Range selection of filtered visible data
 
    For Each c In rng           'C loop around visible 1st column only (A)
            For j = 1 To Range("A1").End(xlToRight).Column
                TextFile.Write Cells(c.Row, j).Value & ","      'Writing on text file
            Next j
        TextFile.Write vbNewLine      'Line Change
    Next c
 
    TextFile.Close          'Text file closure
 
 
Next mnth
 
MsgBox "done!!"
End Sub

-------------------------------------------------------------------------------------------------------------------

Option Explicit

'Macro to convert excel file into text file

Sub ExcelToTextTransfer()

Dim fso As New FileSystemObject
Dim TextFile As TextStream
Dim i, j, mnth As Long
Dim rng, c As Range

'------------Phase I

For mnth = 1 To 12              'Loop for month

    Sheet1.AutoFilterMode = False           'Remove existing filter
    Sheet1.Range("A1").AutoFilter field:=4, Criteria1:=Left(MonthName(mnth), 3)    'Autofilter on month on month

'------------Phase II

    Set TextFile = fso.CreateTextFile("C:\Users\Vinay Kumar\Desktop\VBA Classs\01 Apr\" _
                        & Left(MonthName(mnth), 3) & ".txt") 'Creation of text file
   
'------------Phase III
    Set rng = Range(Range("A1"), Range("A1").End(xlDown))       'Range selection of filtered data
   
    For Each c In rng
        If c.EntireRow.Hidden = False Then                      'If cell is visible perform the activity
            For j = 1 To Range("A1").End(xlToRight).Column
                TextFile.Write Cells(c.Row, j).Value & ","      'Writing on text file
            Next j
        End If
        If c.EntireRow.Hidden = False Then TextFile.Write vbNewLine     'Line Change
    Next c
   
    TextFile.Close          'Text file closure
   
   
Next mnth
   
MsgBox "done!!"
End Sub

Macro to Open Text File

'-----------------------------Macro to Open Text File-----------------------------------'
Sub OpenTextFile_1()

Dim fso As New FileSystemObject
Dim txtfl As TextStream
Dim i, j As Integer
Dim Arr

Application.FileDialog(msoFileDialogOpen).Show          'Selection of text file through file dialogbox
Set txtfl = fso.OpenTextFile(Application.FileDialog(msoFileDialogOpen).SelectedItems(1))    'Intializing text file

'-----------Writing the text file contents in excel file-----------------'
i = 1
j = 1
Do Until txtfl.AtEndOfStream
    Arr = Split(txtfl.ReadLine, ",")
        For i = 1 To UBound(Arr)
            Cells(j, i).Value = Arr(i - 1)
        Next
    j = j + 1
Loop

End Sub



'----------------Another Way to Open Text File
Sub OpenTextFile_2()
Application.FileDialog(msoFileDialogOpen).Show
Workbooks.OpenText Application.FileDialog(msoFileDialogOpen).SelectedItems(1), Tab:=True

Dim i, j As Integer
Dim Arr

j = 1
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    Arr = Split(Range("A" & i).Value, ",")
        For j = 1 To UBound(Arr)
            Cells(i, j).Value = Arr(j - 1)
        Next
Next
End Sub

For Loop to print 1 to 10

Sub Print1to10()

Dim i As Integer
    For i = 1 To 10
        Range("A" & i).Value = i
    Next
 
End Sub