Concatenation with double quotes and comma for the selected list of values

[chakkrav]

Hi,

I have a list of values i.e.


CPARTY_ID_STATUS


GL_GROUPING_CD_OLD_STATUS


GL_GROUPING_CD_STATUS


GL_GRPING_OVERRIDE_STATUS




I'm trying to concatenate them like below
"CPARTY_ID_STATUS",""GL_GROUPING_CD_OLD_STATUS",""GL_GROUPING_CD_STATUS",""GL_GRPING_OVERRIDE_STATUS"

But no luck with the below vba, request forum experts advise!

Set lookupRng = Application.InputBox("Lookup Values", "Select Lookup Values", Type:=8)
MsgBox "The cells selected were " & lookupRng.Address

For Each cell In lookupRng.Cells
QueryString = lookupRng & "'" & lookupRng.Value & "',"
Next
QueryString = Left(yourQueryString, Len(QueryString) - 1) & ") VALUES ("

[paulked]

You got the concatenation correct here:



MsgBox "The cells selected were " & lookupRng.Address


Just apply that principle to your QueryString.

[Dave]

Are U trying to add the parenthesis? Seems like U have double parenthesis between words. HTH. Dave

For Each cell In lookupRng.Cells
querystring = querystring & Chr$(34) & cell.Text & Chr$(34) & "," & Chr$(34)
Next
querystring = Left(yourQueryString, Len(querystring) - 2) '& ") VALUES ("

[chakkrav]

its still not working. I'm basically trying to search multiple values in a row & highlight them. This is the full code and only the concatenation seems to be having issue. Kindly advise!

Sub Find_Multiple_Values()


Dim Answer As VbMsgBoxResult
Answer = MsgBox("Are you sure you want to run the macro?", vbYesNo, "Run Find_Multiple_Values Macro")
If Answer = vbYes Then


Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim WhatToFind As Variant
Dim iCtr As Long
Dim DestCell As Range
Dim iLoop As Long
Dim lookupRng As Range
Dim mycell As Range
Dim yourQueryString As String


Set wks = ActiveSheet


'Data Range
Set rngToSearch = Application.InputBox("Select Data Range", "Obtain Range", Type:=8)
MsgBox "The cells selected were " & rngToSearch.Address


'Lookup Values Range
Set lookupRng = Application.InputBox("Lookup Values", "Select Lookup Values", Type:=8)
MsgBox "The cells selected were " & lookupRng.Address


'To capture Range info and concatenate
With lookupRng
For Each mycell In lookupRng.Rows(2).Cells
set yourQueryString = yourQueryString & "'" & mycell.Value & "',"
Next
yourQueryString = Left(yourQueryString, Len(yourQueryString) - 1) & ") VALUES ("
End With


WhatToFind = Array(yourQueryString)


With rngToSearch
For iCtr = LBound(WhatToFind) To UBound(WhatToFind)
Set rngFound = .Cells(.Cells.Count)
For iLoop = 1 To WorksheetFunction.CountIf(rngToSearch, WhatToFind(iCtr)) ' second loop
Set rngFound = .Cells.Find(What:=WhatToFind(iCtr), _
LookIn:=xlValues, LookAt:=xlWhole, _
After:=rngFound, _
MatchCase:=False)
If Not rngFound Is Nothing Then
rngFound.Interior.Color = RGB(255, 255, 0)
End If
Next iLoop
Next
End With
End If
End Sub

[Dave]

So U actually want select a range to look in then select a range of what to look for and then if found change the interior colour of the cell. Is that correct? Dave

[chakkrav]

Yes perfectly said

[Dave]

Maybe just this...

Sub Find_Multiple_Values()
Dim Answer As VbMsgBoxResult
Answer = MsgBox("Are you sure you want to run the macro?", vbYesNo, "Run Find_Multiple_Values Macro")
If Answer = vbYes Then
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim WhatToFind As Variant
Dim iCtr As Long
Dim DestCell As Range
Dim iLoop As Long
Dim lookupRng As Range
Dim mycell As Range
Dim yourQueryString As String
Set wks = ActiveSheet
'Data Range
Set rngToSearch = Application.InputBox("Select Data Range", "Obtain Range", Type:=8)
MsgBox "The cells selected were " & rngToSearch.Address
'Lookup Values Range
Set lookupRng = Application.InputBox("Lookup Values", "Select Lookup Values", Type:=8)
MsgBox "The cells selected were " & lookupRng.Address
'To capture Range info and concatenate
For Each mycell In rngToSearch '.Rows(2).Cells
If mycell.Text = lookupRng.Text Then
mycell.Interior.Color = RGB(255, 255, 0)
End If
Next
End If
End Sub

Dave

[chakkrav]

It doesn't seem to work.
Attached herewith sample spreadsheet.
Data Range is A1:VI1
Lookup Range is VK2:VK10
I'm trying to search lookup range values in Data Range and get them highlighted.

[georgiboy]

You can achieve this with conditional formatting:

1, Select range A1:AI1
2, Select conditional formatting from the header of the excel app
3, Select "New Rule"
4, Select "Use a formula to determine which cells to format
5, Paste in this formula

=IF(COUNTIF($VK$2:$VK$10,A1)>0,TRUE,FALSE)

6, Hit the "Format" button and select your formats
7, Hit the "OK" button

Hope this helps

[chakkrav]

Thanks Georgiboy i already have that solution but i require VBA Solution & it will be plugged in to other VBA solutions which we already implemented. This is one piece which I couldn't implement & need guidance.

[georgiboy]

Maybe:


Sub HiglightCells()
Dim rcell As Range, LookUprng As Range

Set LookUprng = Range("VK2:VK" & Range("VK" & Rows.Count).End(xlUp).Row).Cells

For Each rcell In Range("A1:VI1").Cells
If WorksheetFunction.CountIf(LookUprng, rcell.Value) > 0 Then
rcell.Interior.Color = vbRed
End If
Next rcell
End Sub

[chakkrav]

The range need to be dynamic based on the user selection, it is going to vary every time

[georgiboy]

Then:


Sub HiglightCells()
Dim rCell As Range, LookUprng As Range, dstRng As Range

Set LookUprng = Application.InputBox("Lookup strings range", "Select cells", Type:=8)
Set destRng = Application.InputBox("Select cells to colour Range", "Select cells", Type:=8)

For Each rCell In destRng.Cells
If WorksheetFunction.CountIf(LookUprng, rCell.Value) > 0 Then
rCell.Interior.Color = vbRed
End If
Next rCell
End Sub

[chakkrav]

Perfect. Thanks & appreciate the help

[georgiboy]

Or this might be faster:


Sub HiglightCells()
Dim LookUprng As Range, destRng As Range, lkup As Variant, dest As Variant
Dim x As Long, y As Long

Set LookUprng = Application.InputBox("Lookup strings range", "Select cells", Type:=8)
Set destRng = Application.InputBox("Select cells to colour Range", "Select cells", Type:=8)

lkup = LookUprng.Cells
dest = Application.Transpose(destRng)

For x = 1 To UBound(dest)
For y = 1 To UBound(lkup)
If dest(x, 1) = lkup(y, 1) Then
Cells(1, x).Interior.Color = vbRed
End If
Next y
Next x
End Sub

[Dave]

georgiboy I can't seem to get your code to work right? The first dynamic code just colours the selection to be searched for. The second code errors or colours the wrong cells? Maybe I have misunderstood the task? I thought U selected a range to search, then selected a range of values to search for. Anything with those values within the range to search is colored. My first post just allowed for a one cell search as I hadn't quite appreciated the magnitude of the task. I messed around with some array code that adds some bells and whistles for error protection. Uses a lot of code/webspace but I thought I might as well post it anyways. Good luck. Dave

Option Explicit
Sub Find_Multiple_Values()
Dim Answer As VbMsgBoxResult, cnt As Integer
Dim Arr() As Variant, EditArr() As Variant, r As Range, r2 As Range
Dim rngToSearch As Range, LookUprng As Range
Answer = MsgBox("Are you sure you want to run the macro?", vbYesNo, "Run Find_Multiple_Values Macro")
If Answer = vbYes Then
'enter Data Range
On Error Resume Next
Set rngToSearch = Application.InputBox("Select Data Range", "Obtain Range", Type:=8)
If Err.Number <> 0 Then
On Error GoTo 0
MsgBox "Enter Range to search!"
Exit Sub
End If
'clear rngtosearch interior color to normal
rngToSearch.Interior.Color = xlNone
MsgBox "The cells selected were " & rngToSearch.Address
'enter search range
On Error Resume Next
'lookup range doesn't need to be in rngtosearch
Set LookUprng = Application.InputBox("Lookup Values", "Select Lookup Values", Type:=8)
If Err.Number <> 0 Then
On Error GoTo 0
MsgBox "Enter Look up range!"
Exit Sub
End If
MsgBox "The cells selected were " & LookUprng.Address
'load Array with lookup range values
cnt = 0
For Each r In LookUprng
ReDim Preserve Arr(cnt + 1)
Arr(cnt) = r.Text
cnt = cnt + 1
Next r
'create unique list of values
EditArr = UniqueArr(Arr)
'color matching values of unique values and rngtosearch
For cnt = LBound(EditArr) To UBound(EditArr)
For Each r In rngToSearch
'to cancel coloring of lookuprng selection
'For Each r2 In lookupRng
'If r2.Address = r.Address Then
'GoTo below
'End If
'Next r2
If EditArr(cnt) = r.Text Then
r.Interior.Color = RGB(255, 255, 0)
End If
below:
Next r
Next cnt
End If
End Sub
Function UniqueArr(InArr As Variant) As Variant
'returns array of unique values from inputted array
Dim cnt As Integer, cnt2 As Integer, cnt3 As Integer, Temparr() As Variant
For cnt = UBound(InArr) - 1 To LBound(InArr) Step -1
For cnt2 = cnt - 1 To 0 Step -1
If InArr(cnt) = InArr(cnt2) Then
GoTo below
End If
Next cnt2
ReDim Preserve Temparr(cnt3)
Temparr(cnt3) = InArr(cnt)
cnt3 = cnt3 + 1
below:
Next cnt
UniqueArr = Temparr
End Function

[georgiboy]

Hi Dave,

Strange that this did not work for you, i did notice that i had the order for the range selections back to front but thought it wouldnt have much of an effect as it prompts the user as to which range to select in the range input box.

I like to keep my examples on this forum as clear as possible so i tend to avoid all of the error handling so as to keep the code readable and easy to follow.

I will include the file i used to test.

21514

[Dave]

georgiboy thanks for your post. I didn't catch on to the reversal of the range selections. I retested your code and the 1st code works for 1 item to be searched for but not for multiple items. The second code works for multiple items to be searched for but not for 1 item. I just made a 4 column by 10 row data set of random letters to test. Select the whole range as the data set (your range to be coloured) and trial varied numbers of search items to be coloured including 1. Anyways, chakkrav has marked this thread as solved and is apparently content with the solution provided which is the important outcome. Have a nice day. Dave