Archive for category: Reference

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, "||||" & 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.chicagocomputerclasses.com/excel-classes/

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 <> -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.chicagocomputerclasses.com/excel-classes/

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 & num
        Next num
End With

Debug.Print endresult

End Sub

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

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" & 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.chicagocomputerclasses.com/excel-classes/