If you often have to convert values from Excel files into SQL filter lists for investigation purposes, this VBA function will save you a lot of time.
Thanks for this function go to Sascha Hombach a highly skilled IT Consultant, who initially developed it for HP ALM filter Strings. I only adjusted it for the use case described above.
Source Code
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
' @Author - Alexander Bolte
' @ChangeDate - 2016-06-25
' @Description - Concatenates the values of all visible cells in the given Range, so that an SQL filter is returned:
' <cellValue1> <strOpLogical> <cellValue2> <strOpLogical> ...
' Default use case is a list of Strings you want to filter for in an SQL statement.
' "select * from aTable where aKey in ('1', 'b', '4');"
' @Returns a comma separated list of values to filter for like "'1', 'b', '4'".
Public Function convertRangeToSqlWhereList(rng As Range, Optional encapsulate As String = "'", Optional strOpLogical = ",") As String
Dim strResult As String
Dim strCellValue As String
Dim cell As Variant
strResult = ""
' Loop through all cells in provided range.
For Each cell In rng.Cells
' Only consider visible and non-faulty cells.
If cell.Rows.Hidden = False And cell.Columns.Hidden = False And Not IsError(cell.value) Then
' Don't add blank cells to the filter.
If Trim(cell.value) <> "" Then
strCellValue = cell.value
strCellValue = encapsulate & cell.value & encapsulate
strResult = strResult & " " & strCellValue & " " & strOpLogical & " "
End If
End If
Next
' Last strOpLogical is cut off.
If strResult <> "" Then: strResult = Trim(Mid(strResult, 1, Len(strResult) - Len(strOpLogical) - 1))
convertRangeToSqlWhereList = strResult
End Function
The function can be called as follows, in order to copy a filter list into the clipboard.
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
Option Explicit
'Amended by Sascha Hombach for write access to the clipboard;
' source: http://msdn.microsoft.com/en-us/library/office/ff192913.aspx
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
As Long
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
As Long, ByVal hMem As Long) As Long
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
'-- end of amendment (see also ClipBoard_SetData())
Public Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "User32" () As Long
Public Declare Function CloseClipboard Lib "User32" () As Long
Public Sub copyRngAsSqlFilterListToClipboard()
On Error GoTo errHandle:
ClipBoard_SetData convertRangeToSqlWhereList(Selection)
errHandle:
If Err.Number <> 0 Then
MsgBox "Uncaught exception." & vbCrLf & Err.Description, vbCritical, cDialogTitle
Err.Clear
End If
End Sub
'Amended by Sascha (comments: see above)
Function ClipBoard_SetData(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, x As Long
' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)
' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If
' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
' Clear the Clipboard.
x = EmptyClipboard()
' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Function
This code snippet is not tested in copied form.
The functions for copying data into the clipboard have been taken from the following URL.
http://msdn.microsoft.com/en-us/library/office/ff192913.aspx
