If you find any post useful then, please do share with others. Thanks!

Popular Posts

Contact

Email me

Need help and that also free? I like to learn this way, in case of any question or for a small task, please feel free to email me with details and example data, if required.

Tuesday, June 11, 2019

Excel VBA - Last Column or Last Row


Find last column of a row, blank and very next to last updated cell

Sometimes in a sheet where we have a data in grid/table, we might want to periodically add data (pulled from somewhere dynamically) in very last column of that grid. For that we first need to identify the very last column on left which is blank and available for new entry.

We can use below VBA code. This will identify the column blank along the last populated column and will update word "Salary" as header there.

So if in Sheet1, we have some data in range A1 to F15, the below code if run, will update word "Salary" in Cell G1.

This is very simple, please try it and in case of any issue or question, please feel free to contact me.

Sub sbLastColumnOfARow()
Sheets("Sheet1").Select
With ActiveSheet
Lastheadcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
LastheadcolumnFinal = Lastheadcolumn + 1
End With
NewcolumnLabel = "Salary"
Cells(1, LastheadcolumnFinal).Value = NewcolumnLabel
End Sub

Similarly finding the last populated row in a column is also easy through below code syntax.


'Find the last non-blank cell in column A(1)
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
And below code is also on same lines. This will add the active cell's value in another sheet's specified column and in the next blank cell and in another respective column's same cell the value of 1 and will take back to the active cell again.

Sub ProductUpdate()
AddProduct = ActiveCell.Value
mysheet = ActiveSheet.Name
mycell = ActiveCell.Address
Sheets("Bill").Select
LastRow = Cells(Rows.Count, 5).End(xlUp).Row + 1
Cells(LastRow, 5).Value = AddProduct
Cells(LastRow, 7).Value = 1
Sheets("Products").Select
Sheets(mysheet).Range(mycell).Select
End Sub

Monday, January 14, 2019

Excel Format Painter > formatting to an entire column/row

Format Painter is the most helpful feature to copy formatting from one cell and applying to others.

With a couple of clicks, we can copy formatting like number format, font, size, color, cell background color, cell borders and text alignment etc.

The feature is available on the home tab in the clipboard group.




Basic use is very simple. Select the cell whose formatting you want to copy and click on Format Painter button. The pointer will change to brush. Now click on the cell where you want to apply the formatting.

Simple way to copy cell formatting to an entire column/row.


  • Select the cell with the desired format and press Ctrl + C to copy its contents and formats
  • Select the entire column or row which we want to format by clicking on its heading
  • Right click the selection and under paste options (Excel 2013), select the option ‘Formatting’. 


This way we will copy just the formatting in entire column, easily.

Wednesday, April 4, 2018

Merging multiple worksheets into one

This code is shared by EDWARD FERKING JR
Special Thanks to him for sharing this. true-north-usa.com  (His Company Website)

We can use below VBA code for same.

Each time we run it, it will insert a new worksheet at the far left of the active workbook and it will vertically summarize (Values and Formats only…aka a static snapshot of) all the worksheets in the active workbook (NOT including any other worksheet summary pages previously generated by the macro).

Sub SummarizeWorkSheets()
Dim wks As Worksheet, sWks As Worksheet, Ur As Range, I As Integer
Dim sWksc As Integer, sWksr As Long, CurrDate As Date, DateStr As String
Application.ScreenUpdating = False: Sheets(1).Select
Set sWks = ActiveWorkbook.Worksheets.Add: CurrDate = Now()
DateStr = Application.Text(CurrDate, "mm dd yyyy hhmmss AM/PM")
sWks.Name = "WbSumry " & DateStr
sWks.Cells(1, 1) = "Workbook Summary of All Worksheets as of " & DateStr
sWks.Cells(1, 1).Font.Size = 22: sWks.Cells(3, 1).Select: ActiveWindow.FreezePanes = True
For Each wks In ActiveWorkbook.Worksheets
If (Not wks.Name Like "WbSumry*") Then
sWks.Activate
sWksr = sWks.UsedRange.Rows.Count: sWksc = sWks.UsedRange.Columns.Count
If sWksc < 40 Then sWksc = 40
sWks.Cells(sWksr + 3, 1) = "Values and Formats From Worksheet [ " & wks.Name & " ]"
sWks.Cells(sWksr + 3, 1).Font.Size = 14
With sWks.Range(Cells(sWksr + 2, 1), Cells(sWksr + 2, sWksc)).Borders(xlEdgeBottom)
.LineStyle = xlDouble: .ColorIndex = xlAutomatic: .TintAndShade = 0: .Weight = xlThick
End With: wks.Activate: Set Ur = wks.UsedRange: Ur.Select: Selection.Copy
sWks.Activate: sWks.Cells(sWksr + 5, 1).Select:
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
sWksr = sWks.UsedRange.Rows.Count: sWksc = sWks.UsedRange.Columns.Count
End If: sWks.Activate:: Next wks
sWks.Cells(1).Select: ActiveWindow.ScrollRow = 1: Application.ScreenUpdating = True
MsgBox ("Worksheet Summary Complete")
End Sub

Tuesday, March 13, 2018

VBA: SQL Connection String and Some Data Formatting

'The below code is for data formatting to use in a SQL query
'We are using connection string to pull data using SQL query
'In comments, below, the code is explained. This is also for future reference, we can copy blocks and use

Sub Amiq()
Sheets("New").Columns("A").ClearContents
Sheets("New").Columns("B").ClearContents
'The above lines clear the contents of A Worksheet namely 'New' from Columns A & B
Sheets("AuditPortal").Columns("R").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("New").Columns("A"), Unique:=True
'The above line copies the column 'R' from Worksheet namely 'AuditPortal', removes duplicates  and paste it in Sheet 'New' and Column A
ThisWorkbook.Worksheets("New").Select
'Select the Sheet 'New'
'In below lines we are using For Loop and for all the Column A rows starting from 2, storing their value in variable SDest after adding single quotes and comma along
'and then along doing some more formatting i.e. Left and Len Function to remove the last comma and adding a single quote at start and finally pasting it in Column 2's first cell
SDest = ""
For iCounter = 2 To WorksheetFunction.CountA(Columns(1))
SDest = SDest & "'" & Cells(iCounter, 1).Value & "'" & ","
Next iCounter
Cells(1, 2).Value = "'" & Left(SDest, Len(SDest) - 1) & ")"

'Below is the SQL connection string. We are first selecting the sheet namely 'sqlResult'
'Our SQL is pasted in Cells(1, 2) of same sheet
'Clearing the range a5:i1000 as we want our results to appear there. A to I range is determined after looking at the columns in our select statement SQL
'Change the name of server from 'OurServer'
ThisWorkbook.Worksheets("sqlResult").Select
Dim sql
sql = Sheets("sqlResult").Cells(1, 2)
Range("a5:I1000") = ""
Dim connString
connString = "ODBC;DSN=OurServer;Description=OurServer;Trusted_Connection=Yes"
Dim thisQT As QueryTable
With ActiveSheet.QueryTables.Add(Connection:=connString, Destination:=Range("a5"))
.BackgroundQuery = False
.sql = sql
.Refresh BackgroundQuery:=True
End With
End Sub