Snippets
Created by
Ian R-P
last modified
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 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | 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)
You can clone a snippet to your computer for local editing. Learn more.