Skip to main content

Excel Steps

 

1.        

EXTRACT A SPECIFIC WORD FROM CELLS AND COUNT 

=COUNTIF(A1:A6,"*sap*")

 

2.        

SARAVANA KUMAR

=SARAVANA & KUMAR

 

3.        

TEXT TO COLUMN

SPLIT THE DETAILS

 

4.        

FILL

Select and pull the row width give the justify

 

5.        

BOOK RACK ALLOCATION

=IF(COUNT(SEARCH("OPERATING SYS",A16898)),"R1","")

 

6.        

FIND THE UPPER CASE AND LOWER CASE SENTENCES

=EXACT(A1,UPPER(A1))

=EXACT(A1,lower(A1))

=EXACT(B1,PROPER(B1)) or =SUBSTITUTE(B1,PROPER(B1),"x")="x"

 

7.        

MISS SPELLED WORDS FIND AND COLOUR (ALT+F11)

 

SAVE WORK SHEET ENABLE MACRO

PRESS ALT+F8

Sub ColorMispelledCells()

For Each cl In ActiveSheet.UsedRange

If Not Application.CheckSpelling(Word:=cl.Text) Then _

cl.Interior.ColorIndex = 28

Next cl

End Sub

 

8.        

EXCEL SPELL MISTAKE

Sub BadSpell()

'red underlines misspelled words in Rng

Dim Rng As Range, C As Range

Set Rng = Sheets("sheet1").Range("A1:A" & _

Sheets("sheet1").Range("A1").End(xlDown).Row)

'reset font

For Each C In Rng

With C

.Font.Underline = False

.Font.ColorIndex = xlAutomatic

End With

Next C

'red underline bad spelling

For Each C In Rng

If Not Application.CheckSpelling(C) Then

With C

.Font.Underline = xlUnderlineStyleSingle

.Font.ColorIndex = 3

End With

End If

Next cl

End Sub

 

9.        

FIND MISSING NUMBERS

=IF(ISNA(VLOOKUP(ROW(A1),$A$1:$A9,1,FALSE)),ROW(A1),"")

=SMALL(B:B,ROW(A1))

https://planetcalc.com/7471/

10.     

=SMALL(IF(ISNA(MATCH(ROW(A$1:A$30),A$1:A$30,0)),ROW(A$1:A$30)),ROW(A1))

Press ctrl+shit+enter

 

11.     

=IF(A2=A1+1,"",A1+1)

 

12.     

Function MissingNumbers(Rng As Range) As String
  Dim X As Long, MaxNum As Long
  MaxNum = WorksheetFunction.Max(Rng)
  ReDim Nums(1 To MaxNum)
  For X = 1 To MaxNum
    If Rng.Find(X, LookAt:=xlWhole) Is Nothing Then
      MissingNumbers = MissingNumbers & ", " & X
    End If
  Next
  MissingNumbers = Mid(MissingNumbers, 3)
End Function

 

=MissingNumbers(A1:A15)

 

13.     

=IF(A2-A1=1,"","Missing")

= SMALL(IF(ISNA(MATCH(ROW(A$1:A$30),A$1:A$30,0)),ROW(A$1:A$30)),ROW(A1))

 

14.     

REMOVE EMPTY ROWS IN EXCEL

FIND & SELECT OPTION – GO TO SPECIAL - CLICK BLANKS – DELETE ROWS OR COLUMN

Sub DeleteBlankRows()

    Dim Rw As Range

    If WorksheetFunction.CountA(Selection) = 0 Then

    MsgBox "No blank rows found", vbOKOnly

    Exit Sub

    End If

    With Application

    .Calculation = xlCalculationManual

    .ScreenUpdating = False

    Selection.SpecialCells(xlCellTypeBlanks).Select

    For Each Rw In Selection.Rows

    If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then

    Selection.EntireRow.Delete

    End If

    Next Rw

    .Calculation = xlCalculationAutomatic

    .ScreenUpdating = True

    End With

    MsgBox "Blank Rows Removed"

    End Sub

 

15.     

EXCEL SPELL MISTAKE

Private Sub CommandButton1_Click()

    Dim oWord As Object

    Dim oDoc As Object

    Dim rngSpelCheck As Range

    Dim FSO As Object

    Dim oFolder As Object

    Dim oPublishObject As PublishObject

    Dim oSpellingErrors As Object

    Dim oError As Object

    Dim rngCell As Range

    Dim strErrorCell As String

    Dim strSearch As String

    Dim bDone As Boolean

    Dim strOldErrorCell As String

    On Error GoTo ErrorRoutine

   

    ' Set column 1 as the target for spellchecking

    Set rngSpelCheck = ActiveSheet.Columns(1)

   

    ' Use Word as the spell checker.

    Set oWord = CreateObject("Word.application")

    ' Find the user's Temp folder

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set oFolder = FSO.GetSpecialFolder(2)

   

    ' Publish an html document containing the text of the cells and errors and more.

    With ActiveWorkbook.PublishObjects.Add(SourceType:=xlSourceRange, _

        Filename:=oFolder.Path & "\TempHTML.html", Sheet:=rngSpelCheck.Parent.Name, Source:=rngSpelCheck.Address, _

        HtmlType:=xlHtmlStatic, DivID:="Spell Check")

            .Publish (True)

            .AutoRepublish = False

    End With

    Set oDoc = oWord.Documents.Open(oFolder.Path & "\TempHTML.html")

   

    oDoc.Range.Text = LCase(oDoc.Range.Text)

    Set oSpellingErrors = oDoc.Range.SpellingErrors

    ' Clear column 2

    ActiveSheet.Columns(2).Value = ""

    ' Loop through the error objects

    For Each oError In oSpellingErrors

        ' The error object contains the 'sentence' (in our case the cell.value)

        strSearch = oError.Sentences(1).Text

        ' Remove carriage returns from the end of the text

        strSearch = Replace(strSearch, Chr(13), "")

        ' Find the cell the text is in

        Set rngCell = ActiveSheet.Range("A:A").Find(What:=strSearch, LookIn:=xlValues, _

        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

        MatchCase:=False, SearchFormat:=False)

       

        If Not rngCell Is Nothing Then

            If Not bDone Then

                ' Initialize the old value of the cell where we placed the error

                strOldErrorCell = Range(rngCell.Address).Offset(0, 1).Address

                bDone = True

            End If

            If Range(rngCell.Address).Offset(0, 1).Address <> strOldErrorCell Then

                'remove the trailing ", "

                Range(strOldErrorCell).Value = Left(Range(strOldErrorCell).Value, Len(Range(strOldErrorCell).Value) - 2)

                strOldErrorCell = Range(rngCell.Address).Offset(0, 1).Address

            End If

            ' Place the misspelled word in column B

            strErrorCell = Range(rngCell.Address).Offset(0, 1).Address

            Range(strErrorCell).Value = Range(strErrorCell).Value & oError & ", "

        End If

    Next oError

    'remove the trailing ", " from the last cell

    Range(strOldErrorCell).Value = Left(Range(strOldErrorCell).Value, Len(Range(strOldErrorCell).Value) - 2)

    strOldErrorCell = Range(rngCell.Address).Offset(0, 1).Address

    If strOldErrorCell = "" Then

        MsgBox "No spelling errors found", vbOKOnly + vbInformation, "Check for spelling errors"

    End If

   

    oDoc.Close False

    Set oDoc = Nothing

    oWord.Quit

    Set oWord = Nothing

    Kill oFolder.Path & "\TempHTML.html"

   

    Exit Sub

ErrorRoutine:

 

    oWord.Quit

    Set oWord = Nothing

 

End Sub

 

16.     

ROW TO COLUMN  PASTE

PASTE—TRANSPOSE

 

17.     

MANY COLUMN INTO SINGLE COLUMN (A COLUMN)

Sub test()

    Dim lastCol As Long, lastRowA As Long, lastRow As Long, i As Long

 

    'find last non empty column number'

    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

 

    'loop through all columns, starting from column B'

    For i = 2 To lastCol

        'find last non empty row number in column A'

        lastRowA = Cells(Rows.Count, "A").End(xlUp).Row

        'find last non empty row number in another column'

        lastRow = Cells(Rows.Count, i).End(xlUp).Row

 

        'copy data from another column'

        Range(Cells(1, i), Cells(lastRow, i)).Copy

        'paste data to column A'

        Range("A" & lastRowA + 1).PasteSpecial xlPasteValues

 

        'Clear content from another column. if you don't want to clear content from column, remove next line'

        Range(Cells(1, i), Cells(lastRow, i)).ClearContents

    Next i

 

    Application.CutCopyMode = False

End Sub

http://stackoverflow.com/questions/21143533/copy-and-paste-excel-data-into-one-column

 

 

 

=index($B2:$AM2;mod(row()-1;quotient(row()-1+1)

 

 

 

 

=INDEX(A:C,ROUNDUP(ROW(A1)/3,),MOD(ROW(A1)-1,3)+1)

18.     

1.       Select the range you want to stack, and go to the Name Box to give this range a name, and press Enter key. See screenshot: mydata

 

=INDEX(MyData,1+INT((ROW(A1)-1)/COLUMNS(MyData)),MOD(ROW(A1)-1+COLUMNS(MyData),COLUMNS(MyData))+1)

https://www.extendoffice.com/documents/excel/4233-excel-stack-columns.html

19.     

ENTER 1 TO 10000 AT

 A TIME

In excel fill –series – step value – 1--- stop value 10000

 

20.     

ROW WISE SORTING

Custom sort-option-sort left to right

 

21.     

WORD – DATE – TIME

Alt+shift+d , alt+shit+t,

 

22.     

WINDOWS GENUINE

Run-cmd-open in admin-type SLMGR –REARM-enter

 

23.     

FACEBOOK BLOCK

C:\windows\system32\drivers\etc\hosts

127.0.0.1 www.facebook.com, www.youtube.com

https://www.youtube.com/watch?v=wQgSFDEEEco

24.     

WORD MERGE CELL

Alt+A then M

 

25.     

EXCEL FREEZE PANE

ALT+W+F+R

 

26.     

CALCULATE DATE, MONTH,YEAR

=DATEDIF(A1,B1,"y") & " years, " & DATEDIF(A1,B1,"ym") & " months, " & DATEDIF(A1,B1,"md") & " days"

 

27.     

PRINTER

HOW MANY PAGES PRINTED

DEVICES AND PRINTERS-PROPERTIES-ABOUT

12.6.15—6973

28.     

PREVENT DUPLICATE ENTRIES WITH DATA VALIDATION FEATURE

 

1.Select the range of cells that will contain the item numbers.

2. Go to Data > Data Validation > Data Validation.

3. And a Data Validation dialog box will display. Click the Settings tab, then click drop down list under Allow, choose Custom, and then enter this formula “=COUNTIF($A$1:$A$20,A1)=1” into the Formula box.

=COUNTIF($A$1:$A$20,A1)=1

29.     

MANY TO ONE COLUMN

COPY CLIPBOARD—DEVELOPER—USE RELATIVE REFERENCE-CTRL+SHIFT+DOWN ARROW—NEXT COLUM

RECORD MACRO --- MACRO NAME—SHORT CUT KEY-OK

 

30.     

COUNT DUPLICATE VALUES

=COUNTIF(A:A, A1)

 

31.     

Combines worksheets in excel

Sub Combine()

Dim J As Integer

On Error Resume Next

Sheets(1).Select

Worksheets.Add

Sheets(1).Name = "Combined"

Sheets(2).Activate

Range("A1").EntireRow.Select

Selection.Copy Destination:=Sheets(1).Range("A1")

For J = 2 To Sheets.Count

Sheets(J).Activate

Range("A1").Select

Selection.CurrentRegion.Select

Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)

Next

End Sub

 

32.     

Combine Excel work sheet

Sub simpleXlsMerger()

Dim bookList As Workbook

Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object

Application.ScreenUpdating = False

Set mergeObj = CreateObject("Scripting.FileSystemObject")

 

'change folder path of excel files here

Set dirObj = mergeObj.Getfolder("D:\change\to\excel\files\path\here")

Set filesObj = dirObj.Files

For Each everyObj In filesObj

Set bookList = Workbooks.Open(everyObj)

 

'change "A2" with cell reference of start point for every files here

'for example "B3:IV" to merge all files start from columns B and rows 3

'If you're files using more than IV column, change it to the latest column

'Also change "A" column on "A65536" to the same column as start point

Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy

ThisWorkbook.Worksheets(1).Activate

 

'Do not change the following column. It's not the same column as above

Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial

Application.CutCopyMode = False

bookList.Close

Next

End Sub

 

33.     

Sub CopyBooks()

    Application.ScreenUpdating = False

    Application.Calculation = xlManual

 

    Dim destinationWorkbook As Workbook

    Set destinationWorkbook = ThisWorkbook

    Dim sourceWorkbook As Workbook

    Dim sourceWorksheet As Worksheet

    Const path As String = "C:\path\to\"

    Dim file As Variant

 

    Dim currentSheets As Long

    currentSheets = destinationWorkbook.Sheets.Count

 

    file = Dir(path & "*.xl*")

 

    While file <> ""

        Set sourceWorkbook = Workbooks.Open(path & file)

            For Each sourceWorksheet In sourceWorkbook.Worksheets

                sourceWorksheet.Copy after:=destinationWorkbook.Worksheets(currentSheets)

                currentSheets = currentSheets + 1

            Next

            sourceWorkbook.Close savechanges:=False

            file = Dir

    Wend

 

    Application.Calculation = xlAutomatic

    Application.ScreenUpdating = True

    End Sub

 

34.     

Insert Empty rows below existing rows

Sub insertrow()
' insertrow Macro

Application.ScreenUpdating = True
Dim count As Integer
Dim X As Integer

For count = 1 To 20
If activecell.Value <> "" Then
activecell.Offset(1, 0).Select
Range(activecell, activecell.Offset(0, 0)).EntireRow.Insert
activecell.Offset(1, 0).Select
For X = 1 To 1
Next X
Else
activecell.Offset(1, 0).Range("a1").Select
End If
Next count

End Sub

 

35.     

Cell contains specific text

=ISNUMBER(SEARCH(substring,text))

 

 

36.     

COMBINE EXCEL SHEETS

Sub GetSheets()

Path = "C:\Users\dt\Desktop\dt kte\"

Filename = Dir(Path & "*.xls")

  Do While Filename <> ""

  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

     For Each Sheet In ActiveWorkbook.Sheets

     Sheet.Copy After:=ThisWorkbook.Sheets(1)

  Next Sheet

     Workbooks(Filename).Close

     Filename = Dir()

  Loop

End Sub

 

37.     

How to check for spaces before or after a string in excel

=IF(LEN(A1)-LEN(TRIM(A1))>0,"SPACE!","")

 

 

38.     

Delete empty rows in word

Sub DeleteEmptyRows_AllTables()

    Dim oTable As Table
    Dim oRow As Row
        
    For Each oTable In ActiveDocument.Tables
        For Each oRow In oTable.Rows
            'Check whether row is empty - delete if it is
            If Len(oRow.Range.Text) = oRow.Cells.Count * 2 + 2 Then
                oRow.Delete
            End If
        Next oRow
    Next oTable
    Exit Sub

End Sub

 

39.     

1=ONE

2=TWO

Option Explicit

 

Public Numbers As Variant, Tens As Variant

 

Sub SetNums()

    Numbers = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")

    Tens = Array("", "", "Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")

End Sub

 

Function WordNum(MyNumber As Double) As String

    Dim DecimalPosition As Integer, ValNo As Variant, StrNo As String

    Dim NumStr As String, n As Integer, Temp1 As String, Temp2 As String

    ' This macro was written by Chris Mead - www.MeadInKent.co.uk

    If Abs(MyNumber) > 999999999 Then

        WordNum = "Value too large"

        Exit Function

    End If

    SetNums

    ' String representation of amount (excl decimals)

    NumStr = Right("000000000" & Trim(Str(Int(Abs(MyNumber)))), 9)

    ValNo = Array(0, Val(Mid(NumStr, 1, 3)), Val(Mid(NumStr, 4, 3)), Val(Mid(NumStr, 7, 3)))

    For n = 3 To 1 Step -1    'analyse the absolute number as 3 sets of 3 digits

        StrNo = Format(ValNo(n), "000")

        If ValNo(n) > 0 Then

            Temp1 = GetTens(Val(Right(StrNo, 2)))

            If Left(StrNo, 1) <> "0" Then

                Temp2 = Numbers(Val(Left(StrNo, 1))) & " hundred"

                If Temp1 <> "" Then Temp2 = Temp2 & " and "

            Else

                Temp2 = ""

            End If

            If n = 3 Then

                If Temp2 = "" And ValNo(1) + ValNo(2) > 0 Then Temp2 = "and "

                WordNum = Trim(Temp2 & Temp1)

            End If

            If n = 2 Then WordNum = Trim(Temp2 & Temp1 & " thousand " & WordNum)

            If n = 1 Then WordNum = Trim(Temp2 & Temp1 & " million " & WordNum)

        End If

    Next n

    NumStr = Trim(Str(Abs(MyNumber)))

    ' Values after the decimal place

    DecimalPosition = InStr(NumStr, ".")

    Numbers(0) = "Zero"

    If DecimalPosition > 0 And DecimalPosition < Len(NumStr) Then

        Temp1 = " point"

        For n = DecimalPosition + 1 To Len(NumStr)

            Temp1 = Temp1 & " " & Numbers(Val(Mid(NumStr, n, 1)))

        Next n

        WordNum = WordNum & Temp1

    End If

    If Len(WordNum) = 0 Or Left(WordNum, 2) = " p" Then

        WordNum = "Zero" & WordNum

    End If

End Function

 

Function GetTens(TensNum As Integer) As String

' Converts a number from 0 to 99 into text.

    If TensNum <= 19 Then

        GetTens = Numbers(TensNum)

    Else

        Dim MyNo As String

        MyNo = Format(TensNum, "00")

        GetTens = Tens(Val(Left(MyNo, 1))) & " " & Numbers(Val(Right(MyNo, 1)))

    End If

End Function

 

After this, From File Menu select Save Book ,from next menu select "Excel 97-2003 Add-In (*.xla)

It will save as Excel Add-In. that will be available till the Ms.Office Installation to that machine.

Now Open any Excel File in any Cell type =WordNum(<your numeric value or cell reference>)

you will see a Words equivalent of the numeric value.

 

This Snippet of code is taken from: http://en.kioskea.net/forum/affich-267274-how-to-convert-number-into-text-in-excel

 

40.     

MAILMERGE PHOTO INSERT

1.       Name the picture or image files the same as (keyed to) the contents of a field in the database. For example, if you have a database which includes a “FirstName” field, you might name personnel photos “John.jpg,” “Mary.jpg,” and so forth. The key to variable images is to have a collection of photo or image files in a folder on your computer or network.

2.       Save As the document in the Word 97 - 2003 (.doc) format -- NOTthe Word 2007 (.docx) format. IncludePicture does not work in .docx documents due to a bug in Word. [Not an issue if you use Word XP or 2003.]

3.       Select the data source (database) into the master document you’ll be working with using Mailings + Select Recipients + Use an Existing List.

4.       Locate where you want to position your image, and insert an image from the image collection (any of them will do for now) onto the page in the usual manner using Insert + Pictures. However, do not press the Insert button at the bottom of the dialog box as usual after selecting the file. Instead, press the little triangle on the right edge of that button to get a three-line menu, and click “Link to File.” Do not format or resize the picture.

5.       Press the Alt + F9 key combination to make the image into a variable image. The picture you just inserted will become something like this on a gray background: 
{ INCLUDEPICTURE “c:\\staff\\pictures\\John.jpg” \*MERGEFORMAT \d }
Note that copying and pasting the above text from this article into Word will not work; you must carry out this procedure as-is.

6.       Select and delete the filename portion, but leave the folder name(s) with the backslashes, and leave the file’s “extension” (.jpg in this case, might be .gif, .bmp, .tif or other). In this example we’ll only remove “John” and the line will now look something like:
{ INCLUDEPICTURE “c:\\staff\pictures\\.jpg” \*MERGEFORMAT \d }

7.       Leave the cursor where “John” used to be, press Mailings + Insert Merge Field and select the database field you need. In this example, you’d get:
{ INCLUDEPICTURE “c:\\staff\\pictures\{ MERGEFIELD “FirstName” }.jpg” \*MERGEFORMAT \d }

8.       Press Alt + F9 again to go back to Picture View to view your handiwork.

9.       Run the Mailings, Finish & Merge, Edit Individual Documents or [or for Word 2003 and XP:Merge to New Document]. Do not merge to a printer, fax or e-mail.

10.    Select the new document; Press Ctrl + A; Press F9.

https://www.youtube.com/watch?v=rztEs-GzQmI

41.     

website hit counter

<div align='center'><a href='http://www.free-website-hit-counter.com'><img src='http://www.free-website-hit-counter.com/c.php?d=9&id=102519&s=10' border='0' title='free website hit counter'></a><br / ><small><a href='http://www.free-website-hit-counter.com' title="website hit">website hit</a></small></div>

https://www.free-website-hit-counter.com/

42.     

date change (mm/dd/yyyy)

=TEXT(A1,"dd/mm/yyyy")

 

43.     

RANK

=RANK(K8,$K$8:$K$58)

 

44.     

DATE OF BIRTH CONVERSION

=TEXT(A1, "MMMM") & " " & NBTEXT(TEXT(A1, "dd")) & ", " & NBTEXT(TEXT(A1, "YYYY"))

 

=WORDNUM(DAY(A1)) & " " & TEXT(A1,"MMMM") & " " & WORDNUM(YEAR(A1)) 

 

Function DateToWords(ByVal xRgVal As Date) As String

'UpdatebyExtendoffice20170926

    Dim xYear As String

    Dim Hundreds As String

    Dim Decades As String

    Dim xTensArr As Variant

    Dim xOrdArr As Variant

    Dim xCardArr As Variant

    xOrdArr = Array("First", "Second", "Third", _

                   "Fourth", "Fifth", "Sixth", _

                   "Seventh", "Eighth", "Nineth", _

                   "Tenth", "Eleventh", "Twelfth", _

                   "Thirteenth", "Fourteenth", _

                   "Fifteenth", "Sixteenth", _

                   "Seventeenth", "Eighteenth", _

                   "Nineteenth", "Twentieth", _

                   "Twenty-first", "Twenty-second", _

                   "Twenty-third", "Twenty-fourth", _

                   "Twenty-fifth", "Twenty-sixth", _

                   "Twenty-seventh", "Twenty-eighth", _

                   "Twenty-nineth", "Thirtieth", _

                   "Thirty-first")

    xCardArr = Array("", "One", "Two", "Three", "Four", _

                   "Five", "Six", "Seven", "Eight", "Nine", _

                   "Ten", "Eleven", "Twelve", "Thirteen", _

                   "Fourteen", "Fifteen", "Sixteen", _

                   "Seventeen", "Eighteen", "Nineteen")

    xTensArr = Array("Twenty", "Thirty", "Forty", "Fifty", _

               "Sixty", "Seventy", "Eighty", "Ninety")

    xYear = CStr(Year(xRgVal))

    Decades = Mid$(xYear, 3)

    If CInt(Decades) < 20 Then

        Decades = xCardArr(CInt(Decades))

    Else

        Decades = xTensArr(CInt(Left$(Decades, 1)) - 2) & "-" & _

                xCardArr(CInt(Right$(Decades, 1)))

    End If

        Hundreds = Mid$(xYear, 2, 1)

    If CInt(Hundreds) Then

        Hundreds = xCardArr(CInt(Hundreds)) & " Hundred "

    Else

        Hundreds = ""

    End If

    DateToWords = xOrdArr(Day(xRgVal) - 1) & _

                  Format$(xRgVal, " mmmm ") & _

                  xCardArr(CInt(Left$(xYear, 1))) & _

                  " Thousand " & Hundreds & Decades

End Function

 

&

 

=DateToWords(A1)

 

45.     

Sum single cell

=SUMPRODUCT(1*MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1))

 

46.     

FIND EMPTY SPACE IN END OF THE WORD

=IF(LEN(A1)-LEN(TRIM(A1))>0,"SPACE!","")

 

47.     

Count duplicate

Data – advanced filter –copy to another location – unique records only - =countif(A:A, C1)

 

48.     

COUNT COMMA

=LEN(TRIM(A1))-LEN(SUBSTITUTE(TRIM(A1),",",""))+1

 

49.     

INITIAL FROM NAME

=LEFT(A2,2)

 

50.     

Spell check in ms-word

https://gregmaxey.com/word_tip_pages/list_spelling_errors_in_document.html

 

51.     

SPELL CHECK IN EXCEL

Sub HighlightMispelledCells()

Dim count As Integer

 

    count = 0

    For Each cell In ActiveSheet.UsedRange

        If Not Application.CheckSpelling(Word:=cell.Text) Then

            cell.Interior.Color = RGB(255, 0, 0)

            count = count + 1

        End If

    Next cell

 

    If count > 0 Then

        MsgBox count & " cells containing misspelled words have been found and highlighted."

    Else

        MsgBox "No misspelled words have been found."

    End If

End Sub

https://www.ablebits.com/office-addins-blog/2018/08/15/spell-check-excel/

52.     

INSERT ROW ON MISSING NUMBERS

Sub Foo()

Dim FNumb As Long, TNumb As Long

Lr = Range("A" & Rows.Count).End(xlUp).Row

TNumb = Range("A" & Lr).Value

Range("A1").Select

FNumb = Selection.Value

Do Until ActiveCell.Value = TNumb

If ActiveCell.Offset(1) = (FNumb + 1) Then

Else

ActiveCell.Offset(1).EntireRow.Insert

End If

FNumb = FNumb + 1

ActiveCell.Offset(1).Select

Loop

End Sub

https://www.mrexcel.com/forum/excel-questions/501195-insert-numbers-based-missing-numbers-series.html

53.     

4 row insert

Sub InsertRowsAtIntervals()
'Updateby20150707
Dim Rng As Range
Dim xInterval As Integer
Dim xRows As Integer
Dim xRowsCount As Integer
Dim xNum1 As Integer
Dim xNum2 As Integer
Dim WorkRng As Range
Dim xWs As Worksheet
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1)
xRows = Application.InputBox("How many rows to insert at each interval? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xNum2 = xRows + xInterval
Set xWs = WorkRng.Parent
For i = 1 To Int(xRowsCount / xInterval)
xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Select
Application.Selection.EntireRow.Insert
xNum1 = xNum1 + xNum2
Next
End Sub

 

54.     

Copy multiple in rows

Sub insertrows()

'Updateby Extendoffice

Dim I As Long

Dim xCount As Integer

LableNumber:

xCount = Application.InputBox("Number of Rows", "Kutools for Excel", , , , , , 1)

If xCount < 1 Then

MsgBox "the entered number of rows is error ,please enter again", vbInformation, "Kutools for Excel"

GoTo LableNumber

End If

For I = Range("A" & Rows.CountLarge).End(xlUp).Row To 2 Step -1

Rows(I).Copy

Rows(I).Resize(xCount).Insert

Next

Application.CutCopyMode = False

End Sub

 

55.     

INITIAL SEPARATOR

=LEN(A2)-LEN(SUBSTITUTE(A2,".",""))

=LEFT(A2,2)

56.     

COMPARE EXCEL SHEETS

=IF(SHEET1!A1 <> SHEET2!A1, "SHEET1:"&SHEET1!A1&" VS SHEET2:"&SHEET2!A1, "")

 

57.     

Spell check in ms-word

https://gregmaxey.com/word_tip_pages/list_spelling_errors_in_document.html

 

58.     

SPELL CHECK IN EXCEL

Sub HighlightMispelledCells()

Dim count As Integer

 

    count = 0

    For Each cell In ActiveSheet.UsedRange

        If Not Application.CheckSpelling(Word:=cell.Text) Then

            cell.Interior.Color = RGB(255, 0, 0)

            count = count + 1

        End If

    Next cell

 

    If count > 0 Then

        MsgBox count & " cells containing misspelled words have been found and highlighted."

    Else

        MsgBox "No misspelled words have been found."

    End If

End Sub

https://www.ablebits.com/office-addins-blog/2018/08/15/spell-check-excel/

59.     

EXTRACT FIRST 3 LETTERS IN EXCEL

=LEFT(E1,3)

 

60.     

BOOK COMPARISON WITH SYLLABUS

=IFERROR(VLOOKUP(B2&"*",$A:$A,1,0),"Not found In KNPC Library")

 

61.     

EXCEL BEGINS WITH COUNT

=COUNTIF(B2:B868, F2) A*

 

62.     

COUNT PDF FILES PAGE  NUMBERS IN ONE FOLDER

Sub Test()

    Dim I As Long

    Dim xRg As Range

    Dim xStr As String

    Dim xFd As FileDialog

    Dim xFdItem As Variant

    Dim xFileName As String

    Dim xFileNum As Long

    Dim RegExp As Object

    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

    If xFd.Show = -1 Then

        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator

        xFileName = Dir(xFdItem & "*.pdf", vbDirectory)

        Set xRg = Range("A1")

        Range("A:B").ClearContents

        Range("A1:B1").Font.Bold = True

        xRg = "File Name"

        xRg.Offset(0, 1) = "Pages"

        I = 2

        xStr = ""

        Do While xFileName <> ""

            Cells(I, 1) = xFileName

            Set RegExp = CreateObject("VBscript.RegExp")

            RegExp.Global = True

            RegExp.Pattern = "/Type\s*/Page[^s]"

            xFileNum = FreeFile

            Open (xFdItem & xFileName) For Binary As #xFileNum

                xStr = Space(LOF(xFileNum))

                Get #xFileNum, , xStr

            Close #xFileNum

            Cells(I, 2) = RegExp.Execute(xStr).Count

            I = I + 1

            xFileName = Dir

        Loop

        Columns("A:B").AutoFit

    End If

End Sub

 

 

63.     

INSERT EMPTY COLUMN

Sub insert_column_every_other()
For colx = 2 To 30 Step 2
Columns(colx).Insert Shift:=xlToRight
Next
End Sub

 

64.     

YOUTUBE VIDEO LINK COPY

var scroll = setInterval(function(){ window.scrollBy(0, 1000)}, 1000);

 

window.clearInterval(scroll); console.clear(); urls = $$('a'); urls.forEach(function(v,i,a){if (v.id=="video-title"){console.log('\t'+v.title+'\t'+v.href+'\t')}});

Right click inspect – console

65.     

Gmail account verification

=AND(IFERROR(FIND(".",A2),FALSE),IFERROR(FIND(".",A2,FIND("@gmail",A2)),FALSE))

 

66.     

Insert Specific Text Before  a Row

Sub test1()

Dim i As Long

Dim xLast As Long

Dim xRng As Range

Dim xTxt As String

On Error Resume Next

xTxt = Application.ActiveWindow.RangeSelection.Address

Set xRng = Application.InputBox("Please select the column with specific text:", "Test", xTxt, , , , , 8)

If xRng Is Nothing Then Exit Sub

If (xRng.Columns.Count > 1) Then

MsgBox "the selected range must be one column", , "Test"

Exit Sub

End If

xLast = xRng.Rows.Count

For i = xLast To 1 Step -1

If InStr(1, xRng.Cells(i, 1).Value, "SI.NO") > 0 Then

Rows(xRng.Cells(i, 1).Row).Insert shift:=x1Down

End If

Next

End Sub

 

67.     

SYSTEM SERIAL NUMBER COMMAND

wmic bios get serialnumber

 

68.     

LOAN PERCENTAGE FIND

=RATE(EMI MONTH,- EMI AMT, LOAN AMT)

THEN

Result*12%*100

 

69.     

Excel Specific colour Text Extract

Function GetColorText(pRange As Range) As String

'UpdatebyExtendoffice20220621

Dim xOut As String

Dim xValue As String

Dim i As Long

Dim TextColor

TextColor = RGB(255, 51, 204) 'colorindex RGB

xValue = pRange.Text

For i = 1 To VBA.Len(xValue)

  If pRange.Characters(i, 1).Font.Color = TextColor Then

  xOut = xOut & VBA.Mid(xValue, i, 1)

  End If

Next

GetColorText = xOut

End Function

 

=GetColorText(A1)

rgb(255, 51, 204);

 

for TNPSC Tamil Books

 

Function colorpart(x As Range)

As String Dim Pra As String

With x

For p = 1 To Len(.Value)

If .Characters(p, 1).Font.Color = RGB(255, 0, 0) Then

Pra = Pra & .Characters(p, 1).Text

End If

Next

End With

colorpart = Pra

End Function

 

=colorpart(a1)

 

https://www.youtube.com/watch?v=z5CadixBQ6E

Comments

Post a Comment

Popular posts from this blog

TNPSC study Materials

https://tnpscstudymaterial.com/site-map/ வினா எழுத்துகள் வினாப் பொருளைத் தரும் எழுத்துகளுக்கு   வினா எழுத்துகள்   என்று பெயர். சில வினா எழுத்துகள் சொல்லின் முதலில் இடம்பெறும். சில வினா எழுத்துகள் சொல்லின் இறுதியில் இடம்பெறும். எ , யா , ஆ , ஓ , ஏ ஆகிய ஐந்தும் வினா எழுத்துகள் ஆகும். •  மொழியின் முதலில் வருபவை –   எ , யா  ( எங்கு , யாருக்கு). •  மொழியின் இறுதியில் வருபவை –   ஆ , ஓ  ( பேசலாமா , தெரியுமோ) •  மொழி முதலிலும் இறுதியிலும் வருபவை –   ஏ  ( ஏன் , நீதானே) 1. அகவினா எது , யார் , ஏன் இச்சொற்களில் உள்ள வினா எழுத்துகளை நீக்கினால் பிற எழுத்துகளுக்குப் பொருள் இல்லை. இவ்வாறு வினா எழுத்துகள் சொல்லின்   அகத்தே இருந்து   வினாப் பொருளைத் தருவது அகவினா எனப்படும். 2. புறவினா அவனா ? வருவானோ ? இச்சொற்களில் உள்ள   ஆ , ஓ   ஆகிய வினா எழுத்துகளை நீக்கினாலும் பிற எழுத்துகள் பொருள் தரும். இவ்வாறு வினா எழுத்துகள் சொல்லின்   புறத்தே வந்து   வினாப் பொருளைத் தருவது புறவினா எனப்படும். சரியான விடையைத் தே...
Post a Comment
Read more