I have a column in a worksheet:
ColumnA
wer
rfvg
swe
dfe
I would like to create a string 'wer','rfvg','swe','dfe' for use in a TSQL query
SELECT value
FROM table
WHERE code IN ('wer','rfvg','swe','dfe')
What I do now:
1. put CONCATENATE("'";A1;"',") in B1
2. drag it all the way down
3. copy+ paste the generated values in ColumnB into my query
What I get is this:
SELECT value
FROM table
WHERE code IN ('wer',
'rfvg',
'swe',
'dfe')
Since these last can contain up to 100 codes that is really annoying.
I would like to create a single continuous string in cell B1.
Is there a way to do this?
Thanx for thinking with me
Here is a macro to do this:
Sub BuildListForQuery
Dim oCells As Object, aCell As Object, oDoc As Object
Dim iColumnA As Integer, sList As String
oDoc = ThisComponent
iColumnA = 0
oColumn = oDoc.Sheets(0).Columns(iColumnA)
oRanges = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
oRanges.insertByName("", oColumn)
oCells = oRanges.Cells.createEnumeration
If Not oCells.hasMoreElements Then Print "Sorry, no text to display"
While oCells.hasMoreElements
aCell = oCells.nextElement
If sList = "" Then
sList = "'" + aCell.String + "'"
Else
sList = sList + ",'" + aCell.String + "'"
End If
Wend
aCell = oDoc.Sheets(0).getCellRangeByName("B1")
aCell.setString(sList)
End Sub
Result in B1 is 'wer','rfvg','swe','dfe'.
How about this:
Put in C1 =CONCATENATE("'",A1,"'")
Put in D1 =CONCATENATE(B1,",'",INDIRECT("A" & COLUMN()-2),"'")
COLUMN returns a number for the column: A is 1, B is 2, etc.
INDIRECT takes a string entry and returns the contents of a cell address, in this case the contents of the cell in column A, row [calculated from column number]. So column D (4) looks at row 2 (4 - 2), column E (5) looks at row 3 (5 - 2), etc.
Copy and paste D1 over however many columns you want (100 columns would be to column CX)
Put in some other cell, we'll say B3 for purposes of this post, =COUNTA(A1:A100) to show how many entries you have in column A
In B1 (the cell where you want the final string) put the formula =INDIRECT(ADDRESS(1,B3+2)) - of course replace B3 with wherever you actually put the COUNTA formula
ADDRESS takes (row number, column number) - here [row 1, column (however many entries in column A + 2)] and returns a LetterNumber cell address
Related
It is above my possibilities.
I know how to create Vba code with Vlookup or Hlookup for single comparision. However whatIi am trying is beyond my knowledge.
I need to compare 2 tables. 1st is requirements where 2nd is DB extract.
Both tables contains same "Action" column and other columns with Employer role as a header. Values from Action column for both tables are the same however in different order ( Those values need to act as primary key).
Columns with Employer role as a header - same header value for both tables - however columns in different order.
Amount of columns with Employer role as a header is not constants and it gets change every time I get this files. Those columns in extract are in different order than in requirements.
Amount of values from "Action" columns ( primary key) also not constants and change every time I receive files. So I cannot set specific range.
Example of Requirements table
Example of Extract table
Example of what is expected
New target worksheet need to be created where Comparison table will be created.
VBA to create Comparison table in newly created worksheet.
This table should have "Action" column + all columns with Employers role as header form requirements + all columns with Employers role as header form extract set in same order like columns in requirements + comparison table which compare values between Employers roles from Requirements and Extract and show values YES or NO
Try the next code, please. It will return in a newly created sheet (after the last existing). The new file is named "New Sheet". If it exists, it is cleared and reused:
Sub testMatchTables()
Dim sh As Worksheet, sh1 As Worksheet, shNew As Worksheet
Dim tbl1 As ListObject, tbl2 As ListObject, rightH As Long
Dim arrR, arrE, arrH1, arrH2, arrFin, i As Long, j As Long, k As Long
Dim first As Long, sec As Long, refFirst As Long, refSec As Long
Set sh = Set sh = Worksheets("Requirements")'use here the sheet keeping the first table
Set sh1 = Worksheets("Extract Table") 'use here your appropriate sheet
Set tbl1 = sh.ListObjects(1) 'use here your first table name (instead of 1)
Set tbl2 = sh1.ListObjects(1) 'use here your second table name (instead of 1)
arrR = tbl1.Range.value 'put the table range in an array
arrE = tbl2.Range.value 'put the table range in an array
'working with arrays will condiderably increase the processing speed
ReDim arrFin(1 To UBound(arrR), 1 To UBound(arrR, 2) * 3 + 2) 'redim the array to keep the processing result
'UBound is a property telling the number of array elements
arrH1 = Application.Index(arrR, 1, 0) 'make a slice in the array (1D array), the first row, which keeps the headers
arrH2 = Application.Index(arrE, 1, 0) 'make a slice in the array (1D array), the first row, which keeps the headers
'build the column headers:
For i = 1 To UBound(arrFin, 2)
If i <= UBound(arrH1) Then 'firstly the headers of the first table are filled in the final array
arrFin(1, i) = arrH1(i)
ElseIf refSec = 0 Then 'refSec is the column where a blanck column will exist
first = first + 1 'the code incrementes this variable to allow making empty only for the following row
If first = 1 Then
arrFin(1, i) = Empty: refFirst = i 'make the empty column between the two tables data and create a reference
'to be decreated from the already incremented i variable
Else
arrFin(1, i) = arrH1(i - refFirst) 'place each header column values
If i - refFirst = UBound(arrH1) Then refSec = i + 1 'when the code reaches the end of the first array
'it creates a reference for referencing the second time
End If
Else
sec = sec + 1 'the same philosophy as above, to create the second empty column
If sec = 1 Then
arrFin(1, i) = Empty 'create the empty column (for each processed row)
Else
arrFin(1, i) = arrH1(i - refSec) 'fill the header columns
End If
End If
Next
Dim C As Long, r As Long, eT As Long, T As Long
eT = UBound(arrR) 'mark the ending of the first array (where to be the first empty column)
T = UBound(arrR, 2) * 2 + 2 'mark the begining of the third final array part
'after the second empty column
For i = 2 To UBound(arrR) 'iterating between the first array rows
For j = 2 To UBound(arrE) 'iterating the second array rows
If arrR(i, 1) = arrE(j, 1) Then 'if the both arrays first column matches
arrFin(i, 1) = arrR(i, 1): arrFin(i, T + 1) = arrR(i, 1) 'put the Action values in the first area columns
arrFin(i, eT) = arrR(i, 1) 'put the Action values in the last area column
For C = 2 To UBound(arrR, 2) 'iterate between the array columns
rightH = Application.match(arrR(1, C), arrH2, 0) 'find the match of the first array header in the second one
arrFin(i, C) = arrR(i, C): arrFin(i, C + eT - 1) = arrE(j, rightH) 'place the matching header in the final array
If arrR(i, C) = arrE(j, rightH) Then
arrFin(i, T + C) = "TRUE" 'place 'TRUE' in case of matching
Else
arrFin(i, T + C) = "FALSE" 'place 'FALSE' in case of NOT matching
End If
Next C
End If
Next j
Next i
On Error Resume Next 'necessary to return an error if worksheet "New Sheet" does not exist
Set shNew = Worksheets("New Sheet")
If err.Number = 9 Then 'if it raises error number 9, this means that the sheet does not exist
err.Clear: On Error GoTo 0 'clear the error and make the code to return other errors, if any
Set shNew = Worksheets.Add(After:=Worksheets(Worksheets.count)) 'set shNew as new inserted sheet
shNew.name = "New Sheet" 'name the newly inserted sheet
Else
shNew.cells.Clear: On Error GoTo 0 ' in case of sheet exists, it is clear and the code is made to return errors
End If
'set the range where the final array to drop its values:
With shNew.Range("A1").Resize(UBound(arrFin), UBound(arrFin, 2))
.value = arrFin 'drop the array content
.EntireColumn.AutoFit 'AutoFit the involved columns
End With
End Sub
Please, test it and send some feedback.
Edited:
I commented the code as detailed I could. If still something unclear, please do not hesitate to ask for clarifications.
I have an excel sheet table with the following data:
In VBA how to search and match for both values in columns A and B and return row value in column C.
Example:
I need to search for the exact match of c+c1 and have as result yy
Many thanks for the help
Use If statements when you loop through the rows like so:
If ws.cells(i,1).Value = c And ws.cells(i,2).value = c1 Then
result = yy
End If
Hope it helps!
U can create a 4th column, this column will be your key column to use in VBA. In this column you will concatenate the A and B values, after that we create a code that search the concat and return the 4th cell on the right.
.
Sub Example()
Dim keyRange As Range
Set keyRange = Planilha1.Range("A2:A8")
Dim SearchValue1, SearchValue2 As String
SearchValue1 = "a"
SearchValue2 = "a2"
Dim lin As Integer
lin = Application.WorksheetFunction.Match(SearchValue1 & SearchValue2, keyRange, 0)
Dim answer As String
answer = Planilha1.Range("A2:D8").Cells(lin, 4)
Debug.Print answer
End Sub
Essentially I am looking to compare the contents of 2 cells and then populate a new cell with the difference. The 2 cells that I am looking to compare the contents of are both list containing product names. An example would be:
Cell 1 contains A,b,c,d
cell 2 contains b,c
I would like cell 3 to then populate with A and D
I am essentially looking to do the opposite of a vlookup function but don't know how I would go about doing that.
Thanks in advance for all your help.
Here's a UDF you could use for this:
' Returns a `delimiter`-joined list containing
' items from minuend (a `delimiter`-joined list)
' but not items from subtrahend (a `delimiter`-joined list)
Public Function SET_SUB(minuend As String, subtrahend As String, Optional delimiter As Variant)
If IsMissing(delimiter) Then delimiter = "," ' Set default delimiter as comma
Dim i As Integer
Dim emptyList As Boolean: emptyList = True
' Retrieve list items
Dim fullSet As Variant
Dim removeSet As Variant
fullSet = Split(minuend, delimiter)
removeSet = Split(subtrahend, delimiter)
SET_SUB = ""
' Loop through subtrahend, removing matches
For i = 0 To UBound(fullSet)
If IsError(Application.Match(fullSet(i), removeSet, 0)) Then
SET_SUB = SET_SUB & fullSet(i) & delimiter
emptyList = False
End If
Next
' Remove last delimiter for non-empty list
If Not emptyList Then
SET_SUB = Left(SET_SUB, Len(SET_SUB) - Len(delimiter))
End If
End Function
Drop that in a module and the function will be accessible on your worksheet (information on UDFs here if you're unfamiliar).
It takes the items in the first list, removes the items in the second list, and returns the set difference. You can optionally add a "delimiter" argument if you want lists separated by something other than commas.
Building off your example:
A1 = a,b,c,d
A2 = b,c
A3 = =SET_SUB(A1, A2) = a,d
For a semicolon-delimited list:
A1 = a;b;c;d
A2 = b;c
A3 = =SET_SUB(A1, A2, ";") = a;d
I have an extremely large dataset with customer numbers and we cannot just use a =IF(E3=160248, "YES", "NO") to tag a particular customer number of 160248 with YES or NO. Instead, I would like to use VBA code to lookup Customer_Number in column E and return a YES or NO in the corresponding row in Column AG, called Incorporated_160248. I have not done an If then clause in VBA, so I have no idea where to start. Please note, each month the data set can change. One month it could be 4,000 entries and the next 3,500, so that has to be dynamic. Any thoughts?
Sub TagTryco()
Dim CN As Integer, result As String
CN = Range("E:E").Value
If CN = 160248 Then
result = "YES"
Else
result = "NO"
End If
Range("AG:AG").Value = result
End Sub
I get a Compile error: Wrong number of arguments or invalid property assignment.
This CODE Works now:
Sub TagTryco()
Dim listLength
listLength = Worksheets("ILS_Import").Cells(Rows.Count, "E").End(xlUp).Row - 1
Dim i As Integer
For i = 2 To listLength + 2
If Worksheets("ILS_Import").Range("E" & i) = 160248 Then
Worksheets("ILS_Import").Range("AG" & i) = "Yes"
Else
Worksheets("ILS_Import").Range("AG" & i) = "No"
End If
Next
End Sub
To know how many entries you have:
dim listLength
listlength = Sheet1.Cells(Rows.Count, "E").End(xlUp).Row - 1 'I assumed column E, starting at row 2
You need to loop from row 2 to the row 2 + listLength, check the cell in column E, and check if it is equal to your number:
dim i as integer
for i = 2 to listLength + 2
If Range("E" & i) = 160248 Then
Range("AG" & i) = "Yes"
Else
Range("AG" & i) = "No"
End If
Next
If you wish to scan for different numbers you can adapt the code to use a value from a cell in which you enter that number, OR use an inputbox to enter the number you want to look for, or something else. This code was not tested.
If you want to use the column name you assigned instead of AG (which is safer) you can use something along the lines of:
= Range("Incorporated_160248")(i+1)
Instead, which gives the column with an offset of i. Should bring you to the right cell.
For i = 1 To 5
changeto = CStr(Sheet15.Cells(1, i).Formula)
newindustry = getfirstword(Worksheets("Industry Insert Template").Range("C1"))
'grab the index position of the comma and exclamation mark
intchangeto = InStr(changeto, ",")
finalchangeto = InStr(changeto, "!")
'extract the worksheet substring
finalindustry = Mid(changeto, intchangeto + 1, finalchangeto - intchangeto - 1)
If finalindustry <> "'Multiples & EPS'" And finalindustry <> "Technicals" Then
finalformula = Replace(changeto, finalindustry, newindustry)
Cells(1, i).Formula = finalformula
End If
Next
Currently this is my macro to adjust the worksheet name.
I want to adjust only the numerical reference.
For example:
=VLOOKUP($B1,Industrials!$CA$41:$GG$41,C$8)
I want to be able to change the cells 41 in the vlookup to reflect the correct row. How would I go through all the cells and change the formula to reflect this?
Use Replace:
Example :
Cells (1, i).Formula = Replace(Cells (1, i).Formula, oldRow, NewRow)
If the value of i is related to the row number, you can use it in place of old row etc.