Reference Archives - Page 2 of 3 - Houston Computer Classes

VBA – Unique List of Data That Appears At Least Once in All Columns – Excel Macro

September 16, 2015/in Excel, Reference, Tutorial /by admin

Use this VBA code to extract a unique list of items that appear inside of multi-column data. The criteria is that the data needs to appear at least once in each column. This one has user friendly interface to run on any size data and get the results wherever user picks in the worksheet.

Sub UniqueListMatchingMultipleColumns()

Dim rng As Range
Dim srcrng As Range

Set rng = Range("g1")

Set srcrng = Application.InputBox("Please select you data (Do not include column headings!)", , , Type:=8)
Set rng = Application.InputBox("Click the cell where you'd like the output to start rendering (a single cell):", , Type:=8)

longstr = "||||"
finalstring = "||||"
For Each i In srcrng

If InStr(longstr, "||||" &amp; i.Value &amp; "||||") = 0 Then

    longstr = longstr &amp; i.Value &amp; "||||"
End If

Next i

For Each word In Split(Mid(longstr, 5, Len(longstr) - 8), "||||")
    n = 1
    got = 0
    For Each col In srcrng.Columns
        mt = Application.Match(word, srcrng.Columns(n), 0)
        If IsNumeric(mt) Then
            got = 1
        Else

            got = 0
            Exit For
        End If

        n = n + 1
    Next col

    If got = 1 Then
        finalstring = finalstring &amp; word &amp; "||||"

    End If

Next word
r = 0
For Each finalword In Split(Mid(finalstring, 5, Len(longstr) - 8), "||||")
    rng.Offset(r, 0).Value = finalword
    r = r + 1
Next finalword

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

Sub UniqueListMatchingMultipleColumns()

Dim rng As Range

Dim srcrng As Range

Set rng = Range("g1")

Set srcrng = Application.InputBox("Please select you data (Do not include column headings!)", , , Type:=8)

Set rng = Application.InputBox("Click the cell where you'd like the output to start rendering (a single cell):", , Type:=8)

longstr = "||||"

finalstring = "||||"

For Each i In srcrng

If InStr(longstr, "||||" & i.Value & "||||") = 0 Then

longstr = longstr & i.Value & "||||"

End If

Next i

For Each word In Split(Mid(longstr, 5, Len(longstr) - 8), "||||")

n = 1

got = 0

For Each col In srcrng.Columns

mt = Application.Match(word, srcrng.Columns(n), 0)

If IsNumeric(mt) Then

got = 1

Else

got = 0

Exit For

End If

n = n + 1

Next col

If got = 1 Then

finalstring = finalstring & word & "||||"

End If

Next word

r = 0

For Each finalword In Split(Mid(finalstring, 5, Len(longstr) - 8), "||||")

rng.Offset(r, 0).Value = finalword

r = r + 1

Next finalword

End Sub

Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/

VBA – Loop Through All Textboxes in a Form – Excel Macro

September 16, 2015/in Excel, Reference, Tutorial /by admin

This VBA code will loop though all textboxes in your userform that are following the naming convention textBox[x] (ex. textBox1, textBox2, textBox3 ….. textBox255)

For Each txtboxitem In Me.Controls
    If Left(txtboxitem.Name, 6) = "textBox" Then
        If txtboxitem.Text &lt;&gt; "" Then

                'do something

            Exit For
        End If
    End If
Next txtboxitem

1

2

3

4

5

6

7

8

9

10

For Each txtboxitem In Me.Controls

If Left(txtboxitem.Name, 6) = "textBox" Then

If txtboxitem.Text <> "" Then

'do something

Exit For

End If

Next txtboxitem

Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/

VBA – Loop Through All (.txt) Files in a User Specified Directory – Excel Macro

August 7, 2015/in Excel, Reference, Tutorial /by admin

This VBA code will loop though all the text files in a directory that user picks from an application box and print a list of them. This code can be modified to be used in many scenarios for any file type.

Sub LoopThroughAllTextFilesInFolder()

    'Declarations
        Dim wb As Workbook
        Dim DirPath As String
        Dim FileName As String
        Dim FileExt As String
        Dim UserFolderChoice As FileDialog
        Dim i As Integer
        Dim howmany As Integer
    'Declarations End

    'Regular Stuff
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual
    'Regular Stuff End

    'User's Folder Choice
        Set UserFolderChoice = Application.FileDialog(msoFileDialogFolderPicker)

        With UserFolderChoice
          .Title = "Select A Target Folder"
          .AllowMultiSelect = False
            If .Show &lt;&gt; -1 Then GoTo AllGood
            DirPath = .SelectedItems(1) &amp; "\"
        End With
    'User's Folder Choice End

AllGood:

    'Check if path is empty
      If DirPath = "" Then GoTo JumpToEnd

    'File Extension
      FileExt = "*.txt"

    'Let's find the first file &amp; how many total files we have
      FileName = Dir(DirPath &amp; FileExt)
      howmany = Len(Dir(DirPath &amp; FileExt))

        'let's loop though them
            For i = 1 To howmany

                'print the name of the file
                Debug.Print FileName

                'move to the next file
                FileName = Dir
            Next i

'Done!!!

JumpToEnd:

    'Regular Stuff
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    'Regular Stuff End

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

Sub LoopThroughAllTextFilesInFolder()

'Declarations

Dim wb As Workbook

Dim DirPath As String

Dim FileName As String

Dim FileExt As String

Dim UserFolderChoice As FileDialog

Dim i As Integer

Dim howmany As Integer

'Declarations End

'Regular Stuff

Application.ScreenUpdating = False

Application.EnableEvents = False

Application.Calculation = xlCalculationManual

'Regular Stuff End

'User's Folder Choice

Set UserFolderChoice = Application.FileDialog(msoFileDialogFolderPicker)

With UserFolderChoice

.Title = "Select A Target Folder"

.AllowMultiSelect = False

If .Show <> -1 Then GoTo AllGood

DirPath = .SelectedItems(1) & "\"

End With

'User's Folder Choice End

AllGood:

'Check if path is empty

If DirPath = "" Then GoTo JumpToEnd

'File Extension

FileExt = "*.txt"

'Let's find the first file & how many total files we have

FileName = Dir(DirPath & FileExt)

howmany = Len(Dir(DirPath & FileExt))

'let's loop though them

For i = 1 To howmany

'print the name of the file

Debug.Print FileName

'move to the next file

FileName = Dir

Next i

'Done!!!

JumpToEnd:

'Regular Stuff

Application.EnableEvents = True

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

'Regular Stuff End

End Sub

Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/

VBA – Get Information From a Web Page – Excel Macro – Amazon Example

July 13, 2015/in Excel, Reference, Tutorial /by admin

This is a basic VBA code to get started with InternetExplorer.Application object and work with web browsers and data extraction. This code is written strictly for learning proposes and should be used as such. Everything is well commenced out so it should be really easy to understand. In this example we use Internet Explorer to open a product page on Amazon and we extract the page title & product price and add the data to our spreadsheet.

Sub Basics_Of_Web_Macro()

    Dim myIE As Object
    Dim myIEDoc As Object

    'Start Internet Explorer
    Set myIE = CreateObject("InternetExplorer.Application")

    'if you want to see the window set this to True
    myIE.Visible = False

    'Now we open the page we'd like to use as a source for information
    myIE.Navigate "http://www.amazon.com/gp/product/B00J34YO92/ref=s9_ri_gw_g421_i1?pf_rd_m=ATVPDKIKX0DER&amp;pf_rd_s=desktop-3&amp;pf_rd_r=090F56JZ7KPTB48JWMDW&amp;pf_rd_t=36701&amp;pf_rd_p=2090151042&amp;pf_rd_i=desktop"

    'We wait for the Explorer to actually open the page and finish loading    
    While myIE.Busy
        DoEvents
    Wend

    'Now lets read the HTML content of the page        
    Set myIEDoc = myIE.Document

    'Time to grab the information we want            

        'We'll start with the Title of the page        
        Range("A1") = myIEDoc.Title
        'Then we'll get something from teh inner page content by using the ID        
        Range("B1") = myIEDoc.getElementById("priceblock_ourprice").innerText

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

Sub Basics_Of_Web_Macro()

Dim myIE As Object

Dim myIEDoc As Object

'Start Internet Explorer

Set myIE = CreateObject("InternetExplorer.Application")

'if you want to see the window set this to True

myIE.Visible = False

'Now we open the page we'd like to use as a source for information

myIE.Navigate "http://www.amazon.com/gp/product/B00J34YO92/ref=s9_ri_gw_g421_i1?pf_rd_m=ATVPDKIKX0DER&pf_rd_s=desktop-3&pf_rd_r=090F56JZ7KPTB48JWMDW&pf_rd_t=36701&pf_rd_p=2090151042&pf_rd_i=desktop"

'We wait for the Explorer to actually open the page and finish loading

While myIE.Busy

DoEvents

Wend

'Now lets read the HTML content of the page

Set myIEDoc = myIE.Document

'Time to grab the information we want

'We'll start with the Title of the page

Range("A1") = myIEDoc.Title

'Then we'll get something from teh inner page content by using the ID

Range("B1") = myIEDoc.getElementById("priceblock_ourprice").innerText

End Sub

Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/

VBA – Get All Numbers in a Text String & Incresae by One – Excel Macro

May 14, 2015/in Excel, Reference, Tutorial /by admin

The following procedure will take any numbers within text and increase them by 1.

For Example:
For20Example51Text will transform into For21Example52Text

Sub UpNumbersByOne()

cell = "YOUR16STRING1HERE10"

Dim v As Variant
 endresult = ""

With CreateObject("VBScript.RegExp")
    .Pattern = "(\d+|\D+)"
    .Global = True
        v = Split(Mid(.Replace(cell, "|$1"), 2), "|")
        For Each num In v
        If IsNumeric(num) = True Then
        num = num + 1
        End If
        endresult = endresult &amp; num
        Next num
End With

Debug.Print endresult

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

Sub UpNumbersByOne()

cell = "YOUR16STRING1HERE10"

Dim v As Variant

endresult = ""

With CreateObject("VBScript.RegExp")

.Pattern = "(\d+|\D+)"

.Global = True

v = Split(Mid(.Replace(cell, "|$1"), 2), "|")

For Each num In v

If IsNumeric(num) = True Then

num = num + 1

End If

endresult = endresult & num

Next num

End With

Debug.Print endresult

End Sub

Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/

VBA – Get First Number & Then Text & Following Number – Excel Macro

May 14, 2015/in Excel, Reference, Tutorial /by admin

This Excel Macro will transform the text data placed in column A and Break it down into 3 Columns.

Data Format Required:
15654 Text goes Here 16 2 6 1595
1 Different Text 1 6
number (space) text of any lenght (space) number (space) other characters

Output will return:

First column: full first number
Second column: full text string in the middle of surrounded numbers
Third Column: first full number after text

Sub BreakTextNum()
lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    For Each cell In Range("a1:a" &amp; lr)

    'grab teh number
    num = Left(cell, InStr(cell, " ") - 1)

    'grab teh text
        For i = 1 To Len(cell)
            Dim currentCharacter As String
            currentCharacter = Mid(cell, InStr(cell, " ") + i, 1)
            If IsNumeric(currentCharacter) = True Then
                GetPositionOfFirstNumericCharacter = i
                Exit For
            End If
        Next i

    txt = Mid(cell, InStr(cell, " ") + 1, i - 2)
    'grab teh after number
    lasti = i + InStr(cell, " ") - 2
    anum = Mid(cell, lasti + 2, InStr(lasti + 2, cell, " ") - lasti - 2)

    Cells(cell.Row, 2) = num
    Cells(cell.Row, 3) = txt
    Cells(cell.Row, 4) = anum

    Next cell

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

Sub BreakTextNum()

lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

For Each cell In Range("a1:a" & lr)

'grab teh number

num = Left(cell, InStr(cell, " ") - 1)

'grab teh text

For i = 1 To Len(cell)

Dim currentCharacter As String

currentCharacter = Mid(cell, InStr(cell, " ") + i, 1)

If IsNumeric(currentCharacter) = True Then

GetPositionOfFirstNumericCharacter = i

Exit For

End If

Next i

txt = Mid(cell, InStr(cell, " ") + 1, i - 2)

'grab teh after number

lasti = i + InStr(cell, " ") - 2

anum = Mid(cell, lasti + 2, InStr(lasti + 2, cell, " ") - lasti - 2)

Cells(cell.Row, 2) = num

Cells(cell.Row, 3) = txt

Cells(cell.Row, 4) = anum

Next cell

End Sub

Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/

Libraries in Chicago

April 23, 2015/in News, Reference /by admin

List of Chicago Libraries with address and phone number.

NAME	Address	PHONE
Albany Park	3401 W. Foster Avenue, Chicago, IL 60625	(773) 539-5450
Altgeld	13281 S. Corliss Avenue, Chicago, IL 60827	(312) 747-3270
Archer Heights	5055 S. Archer Avenue, Chicago, IL 60632	(312) 747-9241
Austin	5615 W. Race Avenue, Chicago, IL 60644	(312) 746-5038
Austin-Irving	6100 W. Irving Park Road, Chicago, IL 60634	(312) 744-6222
Avalon	8148 S. Stony Island Avenue , Chicago, IL 60617	(312) 747-5234
Back of the Yards	2111 W. 47th Street, Chicago, IL 60609	(312) 747-9595
Beverly	1962 W. 95th Street, Chicago, IL 60643	(312) 747-9673
Bezazian	1226 W. Ainslie Street, Chicago, IL 60640	(312) 744-0019
Blackstone	4904 S. Lake Park Avenue, Chicago, IL 60615	(312) 747-0511
Brainerd	1350 W. 89th Street, Chicago, IL 60620	(312) 747-6291
Brighton Park	4314 S. Archer Avenue, Chicago, IL 60632	(312) 747-0666
Bucktown-Wicker Park	1701 N. Milwaukee Avenue, Chicago, IL 60647	(312) 744-6022
Budlong Woods	5630 N. Lincoln Avenue, Chicago, IL 60659	(312) 742-9590
Canaryville	642 W. 43rd Street, Chicago, IL 60609	(312) 747-0644
Chicago Bee	3647 S. State Street, Chicago, IL 60609	(312) 747-6872
Chicago Lawn	6120 S. Kedzie Avenue , Chicago, IL 60629	(312) 747-0639
Chinatown	2353 S. Wentworth Avenue, Chicago, IL 60616	(312) 747-8013
Clearing	6423 W. 63rd Place, Chicago, IL 60638	(312) 747-5657
Coleman	731 E. 63rd Street, Chicago, IL 60637	(312) 747-7760
Daley, Richard J.-Bridgeport	3400 S. Halsted Street, Chicago, IL 60608	(312) 747-8990
Daley, Richard M.-W Humboldt	733 N. Kedzie Avenue, Chicago, IL 60612	(312) 743-0555
Douglass	3353 W. 13th Street, Chicago, IL 60623	(312) 747-3725
Dunning	7455 W. Cornelia Avenue, Chicago, IL 60634	(312) 743-0480
Edgebrook	5331 W. Devon Avenue, Chicago, IL 60646	(312) 744-8313
Edgewater	6000 N. Broadway Street, Chicago, IL 60660	(312) 744-0718
Gage Park	2807 W. 55th Street, Chicago, IL 60632	(312) 747-0032
Galewood-Mont Clare	6871 W. Belden Avenue, Chicago, IL 60707	(312) 746-0165
Garfield Ridge	6348 S. Archer Avenue, Chicago, IL 60638	(312) 747-6094
Greater Grand Crossing	1000 East 73rd Street, Chicago, IL 60619	(312) 745-1608
Hall	4801 S. Michigan Avenue, Chicago, IL 60615	(312) 747-2541
Harold Washington-HWLC	400 S. State Street, Chicago, IL 60605	(312) 747-4300
Hegewisch	3048 E. 130th Street, Chicago, IL 60633	(312) 747-0046
Humboldt Park	1605 N. Troy Street, Chicago, IL 60647	(312) 744-2244
Independence	3548 W. Irving Park Road, Chicago, IL 60618	(312) 744-0900
Jefferson Park	5363 W. Lawrence Avenue, Chicago, IL 60630	(312) 744-1998
Jeffery Manor	2401 E. 100th Street, Chicago, IL 60617	(312) 747-6479
Kelly	6151 S. Normal Boulevard, Chicago, IL 60621	(312) 747-8418
King	3436 S. King Drive, Chicago, IL 60616	(312) 747-7543
Legler	115 S. Pulaski Road, Chicago, IL 60624	(312) 746-7730
Lincoln Belmont	1659 W. Melrose Street, Chicago, IL 60657	(312) 744-0166
Lincoln Park	1150 W. Fullerton Avenue, Chicago, IL 60614	(312) 744-1926
Little Village	2311 S. Kedzie Avenue, Chicago, IL 60623	(312) 745-1862
Logan Square	3030 W. Fullerton Avenue, Chicago, IL 60647	(312) 744-5295
Lozano	1805 S. Loomis Street, Chicago, IL 60608	(312) 746-4329
Manning	6 S. Hoyne Avenue, Chicago, IL 60612	(312) 746-6800
Mayfair	4400 W. Lawrence Avenue, Chicago, IL 60630	(312) 744-1254
McKinley Park	1915 W. 35th Street, Chicago, IL 60609	(312) 747-6082
Merlo	644 W. Belmont Avenue, Chicago, IL 60657	(312) 744-1139
Mount Greenwood	11010 S. Kedzie Avenue, Chicago, IL 60655	(312) 747-2805
Near North	310 W. Division Street, Chicago, IL 60610	(312) 744-0991
North Austin	5724 W. North Avenue, Chicago, IL 60639	(312) 746-4233
North Pulaski	4300 W. North Avenue, Chicago, IL 60639	(312) 744-9573
Northtown	6435 N. California Avenue, Chicago, IL 60645	(312) 744-2292
Oriole Park	7454 W. Balmoral Avenue, Chicago, IL 60656	(312) 744-1965
Portage-Cragin	5108 W. Belmont Avenue, Chicago, IL 60641	(312) 744-0152
Pullman	11001 S. Indiana Avenue, Chicago, IL 60628	(312) 747-2033
Roden	6083 N. Northwest Highway, Chicago, IL 60631	(312) 744-1478
Rogers Park	6907 N. Clark Street, Chicago, IL 60626	(312) 744-0156
Roosevelt	1101 W. Taylor Street, Chicago, IL 60607	(312) 746-5656
Scottsdale	4101 W. 79th Street, Chicago, IL 60652	(312) 747-0193
Sherman Park	5440 S. Racine Avenue, Chicago, IL 60609	(312) 747-0477
South Chicago	9055 S. Houston Avenue, Chicago, IL 60617	(312) 747-8065
South Shore	2505 E. 73rd Street, Chicago, IL 60649	(312) 747-5281
Sulzer Regional	4455 N. Lincoln Avenue, Chicago, IL 60625	(312) 744-7616
Thurgood Marshall	7506 S. Racine Avenue, Chicago, IL 60620	(312) 747-5927
Toman	2708 S. Pulaski Road, Chicago, IL 60623	(312) 745-1660
Uptown	929 W. Buena Avenue, Chicago, IL 60613	(312) 744-8400
Vodak-East Side	3710 E. 106th Street, Chicago, IL 60617	(312) 747-5500
Walker	11071 S. Hoyne Avenue, Chicago, IL 60643	(312) 747-1920
Water Works	163 E. Pearson Street, Chicago, IL 60611	(312) 742-8811
West Belmont	3104 N. Narragansett Avenue, Chicago, IL 60634	(312) 746-5142
West Chicago Avenue	4856 W. Chicago Avenue, Chicago, IL 60651	(312) 743-0260
West Englewood	1745 W. 63rd Street, Chicago, IL 60636	(312) 747-3481
West Lawn	4020 W. 63rd Street, Chicago, IL 60629	(312) 747-7381
West Pullman	830 W. 119th Street, Chicago, IL 60643	(312) 747-1425
West Town	1625 W. Chicago Avenue, Chicago, IL 60622	(312) 743-0450
Whitney M. Young, Jr.	7901 S. King Drive, Chicago, IL 60619	(312) 747-0039
Woodson Regional	9525 S. Halsted Street, Chicago, IL 60628	(312) 747-6900
Wrightwood-Ashburn	8530 S. Kedzie Avenue, Chicago, IL 60652	(312) 747-2696

VBA – Delete Every Other Row – Odd or Even – Excel Macro

April 23, 2015/in Excel, Reference, Tutorial /by admin

This Excel Macro will go through all the cells in column A, find the last cell that has data in it, and then delete every other row in that data range.

To Delete Odd Rows

Sub Delete_Odd()

 Application.ScreenUpdating = False
lr = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

If lr Mod 2 = 0 Then
lr = lr - 1
End If

For i = lr To 1 Step -2
    Rows(i &amp; ":" &amp; i).Delete Shift:=xlUp    
Next i

 Application.ScreenUpdating = True

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

Sub Delete_Odd()

Application.ScreenUpdating = False

lr = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

If lr Mod 2 = 0 Then

lr = lr - 1

End If

For i = lr To 1 Step -2

Rows(i & ":" & i).Delete Shift:=xlUp

Next i

Application.ScreenUpdating = True

End Sub

To Delete Even Rows

Sub Delete_Even()

 Application.ScreenUpdating = False
lr = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

If lr Mod 2 = 0 Then
Else
lr = lr - 1
End If

For i = lr To 1 Step -2
    Rows(i &amp; ":" &amp; i).Delete Shift:=xlUp    
Next i

  Application.ScreenUpdating = True

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

Sub Delete_Even()

Application.ScreenUpdating = False

lr = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

If lr Mod 2 = 0 Then

Else

lr = lr - 1

End If

For i = lr To 1 Step -2

Rows(i & ":" & i).Delete Shift:=xlUp

Next i

Application.ScreenUpdating = True

End Sub

Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/

VBA – Letter Count for Each Alphabet Character – Excel Macro

April 16, 2015/in Excel, Reference, Tutorial /by admin

This Excel Macro will go through all the cells in column A and output the count for each letter in column B. This is for English alphabet only and it will skip all the other characters and spaces.

Sub LetterCount()

Dim ws As Worksheet
Set ws = ActiveSheet

lastrow = Cells(Rows.Count, 1).End(xlUp).Row

rg = Range("a1:a" &amp; lastrow)
i = 1

For c = 97 To 122

cnt = 0

    For Each cell In rg

    lth = Len(cell)
        For lt = 1 To lth

            chktext = Mid(cell, lt, 1)

              If chktext = Chr(c) Then

                cnt = cnt + 1
            End If

        Next lt

    Next cell

    If cnt &gt; 0 Then
        ws.Cells(i, 2) = Chr(c) &amp; " = " &amp; cnt
        i = i + 1
    End If

Next c

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

Sub LetterCount()

Dim ws As Worksheet

Set ws = ActiveSheet

lastrow = Cells(Rows.Count, 1).End(xlUp).Row

rg = Range("a1:a" & lastrow)

i = 1

For c = 97 To 122

cnt = 0

For Each cell In rg

lth = Len(cell)

For lt = 1 To lth

chktext = Mid(cell, lt, 1)

If chktext = Chr(c) Then

cnt = cnt + 1

End If

Next lt

Next cell

If cnt > 0 Then

ws.Cells(i, 2) = Chr(c) & " = " & cnt

i = i + 1

End If

Next c

End Sub

Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/

Excel VBA – Export Each Worksheet to a Separate PDF – Macro

March 25, 2015/in Excel, Reference, Tutorial /by admin

If you need to Export Each sheet to an individual .pdf file this Macro will do it for you.

It will go through all the sheets in your Workbook and save each one to a separate PDF file using the worksheet name as file name.

Sub ExportToPDFs()
' PDF Export Macro
' Change C:\Exports\ to your folder path where you need the diles saved
' Save Each Worksheet to a separate PDF file.

Dim ws As Worksheet

For Each ws In Worksheets
ws.Select
nm = ws.Name

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Exports\" & nm & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

Next ws

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

Sub ExportToPDFs()

' PDF Export Macro

' Change C:\Exports\ to your folder path where you need the diles saved

' Save Each Worksheet to a separate PDF file.

Dim ws As Worksheet

For Each ws In Worksheets

ws.Select

nm = ws.Name

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _

Filename:="C:\Exports\" & nm & ".pdf", _

Quality:=xlQualityStandard, IncludeDocProperties:=True, _

IgnorePrintAreas:=False, OpenAfterPublish:=False

Next ws

End Sub

Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/

To Delete Odd Rows

To Delete Even Rows

Locations: