Snippets

Ian R-P Excel Personal.xlsb Public Macros Workbook

Created by Ian R-P last modified
Function AlphaNumericOnly(strSource As String) As String
    Dim i As Integer
    Dim strResult As String

    For i = 1 To Len(strSource)
        Select Case Asc(Mid(strSource, i, 1))
            Case 32, 33, 35 To 38, 40 To 43, 45 To 95, 97 To 126: ' http://www.asciitable.com/ 10,13 = LF,CF
                strResult = strResult & Mid(strSource, i, 1)
        End Select
    Next
    AlphaNumericOnly = strResult
End Function

Function CountCcolor(range_data As Range, criteria As Range) As Long
    Dim datax As Range
    Dim xcolor As Long
xcolor = criteria.Interior.ColorIndex
For Each datax In range_data
    If datax.Interior.ColorIndex = xcolor Then
        CountCcolor = CountCcolor + 1
    End If
Next datax
End Function

Sub TrimEntireSelection()
   Dim ColumnCount As Long
   Dim RowCount As Long

   ' Loop for each row in selection.
   For RowCount = 1 To Selection.Rows.Count

      ' Loop for each column in selection.
      For ColumnCount = 1 To Selection.Columns.Count

         ' Write current cell's text to file with quotation marks.
         Selection.Cells(RowCount, ColumnCount).Value = Trim(Selection.Cells(RowCount, ColumnCount).Text)

      ' Start next iteration of ColumnCount loop.
      Next ColumnCount
      
   ' Start next iteration of RowCount loop.
   Next RowCount

End Sub

Sub AlphaNumericOnlyOnSelection()
   Dim ColumnCount As Long
   Dim RowCount As Long

   ' Loop for each row in selection.
   For RowCount = 1 To Selection.Rows.Count

      ' Loop for each column in selection.
      For ColumnCount = 1 To Selection.Columns.Count

         ' Write current cell's text to file with quotation marks.
         Selection.Cells(RowCount, ColumnCount).Value = AlphaNumericOnly(Selection.Cells(RowCount, ColumnCount).Text)

      ' Start next iteration of ColumnCount loop.
      Next ColumnCount
      
   ' Start next iteration of RowCount loop.
   Next RowCount

End Sub

Sub QuoteCommaExport()
   ' Dimension all variables.
   Dim DestFile As String
   Dim FileNum As Long
   Dim ColumnCount As Long
   Dim RowCount As Long
   Dim Delimiter As String
   Dim Wrapper As String
   
   ' What delimiter to use for field separation?
   Delimiter = ","
   
   ' What character to use for wrapping each field individually
   Wrapper = """"

   ' Prompt user for destination file name.
   DestFile = InputBox("Enter the destination filename" _
      & Chr(10) & "(with complete path):", "Quote-Comma Exporter", "C:\temp\")

   ' Obtain next free file handle number.
   FileNum = FreeFile()

   ' Turn error checking off.
   On Error Resume Next

   ' Attempt to open destination file for output.
   Open DestFile For Output As #FileNum

   ' If an error occurs report it and end.
   If Err <> 0 Then
      MsgBox "Cannot open filename " & DestFile
      End
   End If

   ' Turn error checking on.
   On Error GoTo 0

   ' Loop for each row in selection.
   For RowCount = 1 To Selection.Rows.Count

      ' Loop for each column in selection.
      For ColumnCount = 1 To Selection.Columns.Count

         ' Write current cell's text to file with quotation marks.
         Print #FileNum, Wrapper & Replace(Selection.Cells(RowCount, ColumnCount).Text, Wrapper, Wrapper & Wrapper) & Wrapper;

         ' Check if cell is in last column.
         If ColumnCount = Selection.Columns.Count Then
            ' If so, then write a blank line.
            Print #FileNum,
         Else
            ' Otherwise, write a comma.
            Print #FileNum, Delimiter;
         End If
      ' Start next iteration of ColumnCount loop.
      Next ColumnCount
   ' Start next iteration of RowCount loop.
   Next RowCount

   ' Close destination file.
   Close #FileNum
End Sub

Sub RemoveAllNAFromEntireSheet()
    Cells.Replace "#N/A", "", xlWhole
End Sub

Comments (0)

HTTPS SSH

You can clone a snippet to your computer for local editing. Learn more.