Wednesday, 15 November 2017

Excel VBA: How to Download Google Sheet

Downloading Google Sheets is easy as a click.

Sub DownloadGoogleSheets()

Dim ShtUrl, Location, FileName As String
Dim objWebCon, objWrit As Object

'Sheet Url
ShtUrl = "https://docs.google.com/spreadsheets/d/1Fy8T1FeEDzFX9U8_lQDk0HrLNSDGjTDUZFxlx-PWXbY/export?format=csv&id=1Fy8T1FeEDzFX9U8_lQDk0HrLNSDGjTDUZFxlx-PWXbY&gid=0'Need to replace id and gid

'Location
Location = ThisWorkbook.Path & "\"  'C:\Export\" Replace with location

'FileName
FileName = "GoogleSheet.csv"

'Connection to Website
Set objWebCon = CreateObject("MSXML2.XMLHTTP.3.0")

'Writer
Set objWrit = CreateObject("ADODB.Stream")

'Connecting to the Website
objWebCon.Open "Get", ShtUrl, False
objWebCon.Send (ShtUrl)

'Once page is fully loaded
If objWebCon.Status = 200 Then

'Write the text of the sheet
objWrit.Open
objWrit.Type = 1
objWrit.Write objWebCon.ResponseBody
objWrit.Position = 0
objWrit.SaveToFile Location & FileName
objWrit.Close

End If

Set objWebCon = Nothing
Set objWrit = Nothing

End Sub

See it in Action

Sunday, 5 November 2017

Excel VBA: How to Create Folders and Sub Folders using Excel List

Need to Create Many Folders and SubFolders With less than a Minute.
Below is the solution to your problem.


Sub CreateFoldersandSubFolders()

'Execute next line in case of error.
On Error Resume Next

'Loop through all the cells  in column 1 in Active Sheet.
For i = 1 To ActiveSheet.UsedRange.Rows.Count

'Name of the Folder
sFolderPath = ThisWorkbook.Path & "\" & Cells(i, 1)  'Replace This.Workbook.Path with any location Example "C:\" & Cells(i,1)

'Creating Folder Using Shell Function
Shell "cmd /c mkdir """ & sFolderPath & """", vbHide 'It will Execute Dos Command and use MKDIR to Make Directory of sFolderPath Value

'To continue the Loop
Next i

'Displaying Message
MsgBox "Folders Created"

End Sub

See it in Action.

Tuesday, 14 February 2017

Excel VBA: How to Merge Multiple Workbooks to One from a Folder

Ever Wonder to Copy all the Workbooks into one Workbook.
In this post i will share the script to copy all the excel files from one folder to Single Excel File.

Below is the Script

Sub MergeMultipleWorkbooks()

'Define Variables
Dim Path, FileName As String

'Assign Values to Variables
Path = Assign a Folder  which contains excel files for example "C:\Merge\"
FileName = Dir(Path & "*.xlsx")

'Check FileName in the Given Location
Do While FileName <> ""

'Open Excel File
Workbooks.Open FileName:=Path & FileName, ReadOnly:=True

'Copy all the sheet to this workbook
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet

'Close the ActiveWorkbook
Workbooks(FileName).Close
'Assign a Excel FileName

'Assign Next Excel FileName
FileName = Dir()
Loop

'Display a Message
MsgBox "Files has been copied Successfull", , "MergeMultipleExcelFiles"
End Sub

See it in Action.

Sunday, 29 January 2017

Excel VBA: How to Create a User Form

To Create a User Form in Excel. Press Alt + F11 on your Keyboard.
You will see the below image.






















Now go to Insert => User Form



















Rename the Form by going to properties
Name as SimpleForm (This name will be used to call from VBA Code)
Caption as Simple Form (This name will be displayed on the Form)





















Now Add Three Labels , Text Box and Command Button.





















Double Click on Submit Button and add below code.

Private Sub btnSubmit_Click()

'Declare the Variables
Dim DATA As Worksheet
Dim LastRow As Integer

'Assinging DATA as worksheet Object
Set DATA = Worksheets("DATA")

'Finding LastRow in DATA Sheet
LastRow = DATA.Cells.SpecialCells(xlCellTypeLastCell).Row

'Validating all the fields to check all the fields are entered

If txtName.Value = "" Then
MsgBox "Please Enter a Valid Name", , "Simple Form"
Exit Sub
ElseIf txtCity.Value = "" Then
MsgBox "Please Enter a Valid City Name", , "Simple Form"
Exit Sub
ElseIf txtCountry.Value = "" Then
MsgBox "Please Enter a Valid Country Name", , "Simple Form"
Exit Sub
End If

'Copying the data entered in Simple Form to DATA Sheet
DATA.Cells(LastRow + 1, 1).Value = txtName.Value
DATA.Cells(LastRow + 1, 2).Value = txtCity.Value
DATA.Cells(LastRow + 1, 3).Value = txtCountry.Value

'Display a Message
MsgBox "Form has been submitted Successfully", , "Simple Form"

'Resetting all the fields to blank
btnReset_Click

End Sub
-------------------------------------------------------------------------------------------------------------
Double click on Reset Button and add below code.

Private Sub btnReset_Click()

'Resetting all the fields
txtName.Value = ""
txtCity.Value = ""
txtCountry.Value = ""

End Sub
--------------------------------------------------------------------------------------------------------------
Double click on Close Button and add below code.

Private Sub btnClose_Click()

'Hiding Form
SimpleForm.Hide
End Sub
---------------------------------------------------------------------------------------------------------------
Now Go to Insert and Click on Module.

Sub OpenForm()
'Open a Form
SimpleForm.Show
End Sub
---------------------------------------------------------------------------------------------------------------
Now in the DATA Sheet add Shape by going to Insert => Shape.

Right Click on Selected Sheet and Select Assign Macro.





















Select Open Form

Now to Start form click on Simple Form.





















See it in Action.


Thursday, 26 January 2017

Excel VBA: How to Merge Multiple Sheet into One Sheet

Merging more than one sheets in excel may be time consuming. But with the below VBA code it will only take few seconds to complete the task.

Below is the VBA Code.

Sub MergeSheet()

'Declaring the Variables
Dim LastRow, ShtCnt As Integer
Dim ShtName As String
Dim NewSht As Worksheet

'Assinging a Sheet Name by UserInput
ShtName:
ShtName = InputBox("Enter the Sheet Name you want to create", "Merge Sheet", "Master Sheet")

'Count of Total Worksheet in the present workbook
ShtCnt = Sheets.Count

'Using For Loop check if the worksheet exists
For i = 1 To ShtCnt
If Sheets(i).Name = ShtName Then
MsgBox "Sheet already Exists", , "Merge Sheet"
GoTo ShtName
End If
Next i

'Create a New Sheet
Worksheets.Add.Name = ShtName

'Assigning NewSht as Current Sheet
Set NewSht = ActiveSheet

'Moving Worksheet to the beginning of this workbook
NewSht.Move before:=Worksheets(1)

'Copying all the data to the New Sheet Using For Loop
For i = 2 To ShtCnt + 1

'If i=2 Then copy all the data from the second sheet including header.
If i = 2 Then
Sheets(i).UsedRange.Copy NewSht.Cells(1, 1)
Else

'If i is grater than 2 then copy all the data excluding Header(1st Row).
Sheets(i).UsedRange.Offset(1, 0).Resize(Sheets(i).UsedRange.Rows.Count - 1, Sheets(i).UsedRange.Columns.Count).Copy NewSht.Cells(LastRow + 1, 1)
End If
LastRow = NewSht.Cells.SpecialCells(xlCellTypeLastCell).Row
Next i

'Displaying the Message after copying data successfully
MsgBox "Data has been copied to " & ShtName, , "Merge Sheet"

End Sub

See it in Action.

Sunday, 15 January 2017

Excel VBA: How to Extract Data from Excel to Text File

In this post we are going to see how to export data from excel to text file using VBA.

Below is the VBA Code.

Sub ExceltoText()

'Declaring the variables
Dim FileName, sLine, Deliminator As String
Dim LastCol, LastRow, FileNumber As Integer

'Excel Location and File Name
FileName = Thisworkbook.path & "\ExceltoText.txt"

'Field Separator
Deliminator = "|"

'Identifying the Last Cell
LastCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
FileNumber = FreeFile

'Creating or Overwrighting a text file
Open FileName For Output As FileNumber

'Reading the data from Excel using For Loop
For i = 1 To LastRow
For j = 1 To LastCol

'Removing Deliminator if it is wrighting the last column
If j = LastCol Then
sLine = sLine & Cells(i, j).Value
Else
sLine = sLine & Cells(i, j).Value & Deliminator
End If
Next j

'Wrighting data into text file
Print #FileNumber, sLine
sLine = ""
Next i

'Closing the Text File
Close #FileNumber

'Generating message to display
MsgBox "Text file has been generated"

End Sub

See it in action.


Saturday, 7 January 2017

Excel VBA: Finding Last Cell

From the below VBA Code you will be able to find last cell in excel

Sub LastCell()  'Name of a Code
'Declaring the Variables
Dim LastCell As Integer 'Declaring the Variables

'Performing All VBA Action in the Active Sheet
With ActiveSheet

'Finding Last Row in a Sheet
LastCell = .Cells.SpecialCells(xlCellTypeLastCell).Row

'Displaying Message
MsgBox LastCell, , "LastRowinaSheet"

'Finding Last Column in a sheet
LastCell = .Cells.SpecialCells(xlCellTypeLastCell).Column

'Displaying Message
MsgBox LastCell, , "LastColumninaSheet"

'Finding Last Row in a Sigle Colum
LastCell = .Cells(.Cells.Rows.Count, "F").End(xlUp).Row

'Displaying Message
MsgBox LastCell, , "LastRowinaSingleColumn"

'Finding Last Column in a Single Row.
LastCell = .Cells(7, .Cells.Columns.Count).End(xlToLeft).Column

'Displaying Message
MsgBox LastCell, , "LastColumninaSingleRow"

'Finding Last Row using UsedRange
LastCell = .UsedRange.Rows(.UsedRange.Rows.Count).Row

'Displaying Message
MsgBox LastCell, , "LastRowUsingUsedRange"

'Finding Last Column using UsedRange
LastCell = .UsedRange.Columns(.UsedRange.Columns.Count).Column

'Displaying Message
MsgBox LastCell, , "LastColumnUsingUsedRange"

End With

End Sub