I have two tables. One of them has server names. The other has timestamps (first table, column A below) and text strings (first table, column B below). I want to search those strings for a keywords specified in the server table (second table below). If the match is found function writes to the cell name from the header of the column where the keyword is.
Example
I want to complete column System in Blue table. So for example C2 should show GreenSys and C8 - RedSys.
I have tried using SEARCH function but it looks like it tries to match whole table to the string if I pass it as an argument. VLOOKUP doesnt work too as I am using two tables. What's the best way for me to get this working?
If you change the way you have the data setup so that it is a bit more Excel-friendly, this can be rather easily accomplished.
The lookup sheet should look like this (the formula below has this as 'Sheet2'):
Then on your main data sheet, in cell C2 and copied down:
=IF(SUMPRODUCT(COUNTIF(B2,"*"&Sheet2!$A$2:$A$7&"*")),INDEX(Sheet2!B:B,SUMPRODUCT(COUNTIF(B2,"*"&Sheet2!$A$2:$A$7&"*")*ROW(Sheet2!$A$2:$A$7))),"")
The results look like this:
With the assumption that all Servers start with "Serv".. this should work without using vba.
=MID(B1,SEARCH("Serv",B1,1),IF(ISERROR(SEARCH(" ",B1,SEARCH("Serv",B1,1))),LEN(B1)-SEARCH("Serv",B1,1),SEARCH(" ",B1,SEARCH("Serv",B1,1))-SEARCH("Serv",B1,1)))
Essentially the formulas searches for the keyword serv and then attempts to parse until the end of the word to return the full name.
As someone else mentioned, it would be easier to do with vba but then again there is a benefit of not having macros.
Can you try this formula to cellC2?
=IF(SUMPRODUCT((B2=Sheet2!$A$2:$D$4)*COLUMN(Sheet2!$A$1:$D$1))>0,
INDEX(Sheet2!$A$1:$D$1,SUMPRODUCT((B2=Sheet2!$A$2:$D$4)*COLUMN(Sheet2!$A$1:$D$1)))
,"")
I have assumed that the second table is at Sheet2 and that data is upto column D, starting with the headers at A1, with the format you describe.
EDIT:
I can see you have amended the original post, and my answer no longer meets the specifications. Therefore I think it is best that I delete it.
EDIT2:
Added VBA solution. Assumptions:
Orignal data table in Sheet1
Destination table in Sheet2
Headers of Sheet1 in 1st row
The below code was tested, it should be OK but needs error handling:
Sub moveData()
Dim rngDestination As Range
Dim lRowCounter As Long, lColCounter As Long, lValueCounter As Long, lLastRow As Long
Dim vOriginArray As Variant, vValuesArray As Variant, vDestinationArray As Variant
' Database table in Sheet2
vOriginArray = Sheet2.UsedRange.Value
' Destination table in Sheet1
With Sheet1
lLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
' Put the values we need to compare into an array
vValuesArray = .Range(.Cells(2, 2), .Cells(lLastRow, 2)).Value
Set rngDestination = .Range(.Cells(2, 3), .Cells(lLastRow, 3))
End With
' We will store the values to an array first and then
' back to the sheet, it is faster this way
ReDim vDestinationArray(1 To rngDestination.Rows.Count, 1 To 1)
' Loop through all rows and columns, exclude header row
For lRowCounter = 2 To UBound(vOriginArray, 1)
For lColCounter = LBound(vOriginArray, 2) To UBound(vOriginArray, 2)
' For each entry, find which values match and store them
For lValueCounter = 1 To UBound(vValuesArray, 1)
If InStr(1, vValuesArray(lValueCounter, 1), vOriginArray(lRowCounter, lColCounter), vbTextCompare) Then
vDestinationArray(lValueCounter, 1) = vOriginArray(1, lColCounter)
End If
Next lValueCounter
Next lColCounter
Next lRowCounter
' Put the data back to excel
With rngDestination
.ClearContents
.Value = vDestinationArray
End With
End Sub
Related
My apologies up front if this post contains too much information. I am new to VBA and this site.
After some difficulties trying to run a Macro I recorded, I have tried to break it up into smaller portions. One of those portions includes appending two columns of data, which will then be used to create a table. The data in these columns is coming from two other worksheets in the same workbook.
When the data is transferred directly by me, the shortened Macro works fine. However, when I use a formula to transfer the data, the Macro does not work. I would appreciate suggestions on how to edit the shortened Macro to either adjust for the formula or edit the VBA to transfer the data and then append, so I might then proceed with attempting to create the table. The code I have been using is:
Dim col As Range, _
found As Range
Dim currRow As Integer
currRow = ActiveSheet.Range("A:A").Find("", after:=ActiveSheet.Range("A1"), lookat:=xlWhole, searchdirection:=xlNext).Row
For Each col In ActiveSheet.UsedRange.Columns
If col.Column <> 1 Then
Set found = col.EntireColumn.Find("", after:=col.Cells(1, 1), lookat:=xlWhole, searchdirection:=xlNext)
Set found = ActiveSheet.Range(col.Cells(1, 1), found)
found.Copy
ActiveSheet.Cells(currRow, 1).PasteSpecial
currRow = currRow + found.Cells.Count - 1
End If
Next col
End Sub
I should have mentioned the columns of data being copied to the worksheet will have headers and vary in the number of rows from workbook to workbook. I will try to attach images of the start and desired endpoints.
The formulas are applied to 200 rows in each column. When I use the Macro on the data copied using the formula, it seems to append the 200 cells of formula from column 2 to the 200 cells of formula in column 1. The data stays in each column, and after my last data point in column 1 I now have blank cells down to row 400 that have the formula instead of data.
BEginning View
Possible Append Result 1
Possible Append result 2
I have written a bunch of VBA macros to get my data formatted how I need it, and the last step is to sort by this new column I have generated in ascending order. However, when I hit sort by the new column, the code now places all the empty cells above my newly generated column as I think it is reading the empty as a 0 and sorts it above any alphanumeric data. This is happening because of the UDF I have for sorting the data. I need to insert the new column with the UDF for each new cell that I insert, but I don't know how to define the range in the new column.
I am close to solving this but would love some help.
Essentially what I have tried for placing the data in a new column works, but the way I have set the range is placing it in a bad spot and it can easily be sorted in the wrong order now. I include all of my code, but the issue is in the last portion of it where I am setting a range to place the new data.
I think what is happening is when I set my range from C3-C2000 and populate it, the remaining empty cells are now included in my sort and give me "lower" numbers when I sort it ascending. Thus all the empty cells are ranked higher up in the column.
Option Explicit
Sub ContractilityData()
Dim varMyItem As Variant
Dim lngMyOffset As Long, _
lngStartRow As Long, _
lngEndRow As Long
Dim strMyCol As String
Dim rngCell As Range
Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'make new column for the data to go
lngStartRow = 3 'Starting row number for the data. Change to suit
strMyCol = "A" 'Column containing the data. Change to suit.
Application.ScreenUpdating = False
For Each rngCell In Range(strMyCol & lngStartRow & ":" & strMyCol & Cells(Rows.Count, strMyCol).End(xlUp).Row)
lngMyOffset = 0
For Each varMyItem In Split(rngCell.Value, "_") 'put delimiter you want in ""
If lngMyOffset = 2 Then 'Picks which chunk you want printed out (each chunk is set by a _ currently)
rngCell.Offset(0, 1).Value = varMyItem
End If
lngMyOffset = lngMyOffset + 1
Next varMyItem
Next rngCell
Application.ScreenUpdating = True
'Here is where my problem arises
Range("C:C").EntireColumn.Insert
Dim sel As Range
Set sel = Range("C3:C2000")
sel.Formula = "=PadNums(B3,3)"
MsgBox "Data Cleaned"
End Sub
What I would like instead is a way to insert a new column, then have my UDF "PadNums" populate each cell up to the last cell of the previous column, essentially re-naming all my data from the previous column. I can then sort by the new column in ascending order and my data is in the correct order.
I think perhaps what I should do is copy column B into my newly inserted column C, then use some sort of last row function to apply the formula in all cells. That would give me the appropriate range always based on my original column?
I solved this! What I did was use range and xlDown to last row on column B, then pasted it to C, then inserted my UDF into C using the xlDown range!
I'm using macros to quickly search a large table of student data and consolidate it into a single cell for use in seating plans (I'm a teacher). Most of it works but I have a problem with selecting just the data I need.
Steps:
1. Remove data.
2. Run a formula to check if students fit into particular groups and consolidate their information
3. Format
Different subjects and year groups have different layouts for their data and so this step is causing me problems. I've tried using absolute cell references in step 2 but this doesn't work as sometimes the information that should be in column D is in column E etc.
What I want to be able to do is have a macro that checks the first value in the column (ie the title) and if it doesn't match one of a predetermined list delete the whole column along with it's data.
Dim rng As Range
For Each rng In Range("everything")
If rng.Value = "Test" Or rng.Value = "Test1" Then
rng.EntireColumn.Hidden = True
End If
I think I could use something like this if I could change the output from hiding columns to deleting them?
re: What I want to be able to do is have a macro that checks the first value in the column (ie the title) and if it doesn't match one of a predetermined list delete the whole column along with it's data.
To delete all columns NOT WITHIN the list:
Sub del_cols()
Dim c As Long, vCOL_LBLs As Variant
vCOL_LBLs = Array("BCD", "CDE", "DEF")
With Worksheets("Sheet7") '<~~ set this worksheet reference properly!
For c = .Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
If IsError(Application.Match(.Cells(1, c), vCOL_LBLs, 0)) Then
.Columns(c).Delete
End If
Next c
End With
End Sub
To delete all columns WITHIN the list:
Sub del_cols()
Dim v As Long, vCOL_LBLs As Variant
vCOL_LBLs = Array("BCD", "CDE", "DEF")
With Worksheets("Sheet7") '<~~ set this worksheet reference properly!
For v = LBound(vCOL_LBLs) To UBound(vCOL_LBLs)
Do While Not IsError(Application.Match(vCOL_LBLs(v), .Rows(1), 0))
.Cells(1, Application.Match(vCOL_LBLs(v), .Rows(1), 0)).EntireColumn.Delete
Loop
Next v
End With
End Sub
I have an Excel database and I'm trying avoid doing some manual combining of duplicate data. I've got a bunch of listings that are essentially the same aside from the tags column. What I'd like to have it do is combine these 5 listings into 1 listing, making the categories a comma separated list in a single cell.
Turn this
into this
Is there any way of achieving this? My document has a couple thousand listings, so I'm obviously trying to avoid the manual edit route. I'm an Excel novice, so any hand holding or tutorials you could point me to would be appreciated.
This can also be done using formulas. For my example to work, the data would need to be sorted by the first column and there would need to be a header row.
You would need two more columns (C & D). First, add a formula that essentially says to concatenate the data in column B if data in column A is the same as the row above it, otherwise reset the concatenation. The next column would contain a formula to identify the final concatenations so you can sort later.
This is how I would do it with listings and categories in columns A & B (again, the data would need to be sorted by column A and there would need to be a header row):
Here's the results. Now I would copy the entire range and paste values into another sheet. The rows with zero for column D is what I'd want to use. Sorting by column D would float them to the top.
This will (should) generate a new sheet from your source sheet with the duplicates concatenated.
To use the following code you need to add it to a new module in the VBA Editor
A Shortcut to open the VBA Editor is Alt+F11 (for Windows) and Alt+Fn+F11 (for Mac)
Once the Editor is open add a new module by selecting it from the "insert" menu in the main menu bar. It should automatically open the module ready to accept code, If not you need to select it (will be named "ModuleN" where N is the next available number) from the project explorer.
I'm not sure if the "Scripting.Dictionary" is available in osx, but it cant hurt to try.
Option Explicit
Sub Main()
Dim Source As Worksheet: Set Source = ThisWorkbook.Worksheets("Sheet1")
Dim Destination As Worksheet: Set Destination = ThisWorkbook.Worksheets("Sheet2")
Dim Records As Object: Set Records = CreateObject("Scripting.Dictionary")
Dim Data As Variant
Dim Index As Long
Dim Row As Integer: Row = 1
Data = Source.Range("A1", "B" & Source.Rows(Source.UsedRange.Rows.Count).Row).Value2
For Index = LBound(Data, 1) To UBound(Data, 1)
If Records.Exists(Data(Index, 1)) Then
Destination.Cells(Records(Data(Index, 1)), 2).Value2 = Destination.Cells(Records(Data(Index, 1)), 2).Value2 & ", " & Data(Index, 2)
Else
Records.Add Data(Index, 1), Row
Destination.Cells(Row, 1).Value2 = Data(Index, 1)
Destination.Cells(Row, 2).Value2 = Data(Index, 2)
Row = Row + 1
End If
Next Index
Set Records = Nothing
End Sub
Copying the values of a filtered range to an array seems to work without a problem: the array then contains values from both filtered and unfiltered cells. However, when I copy the array's contents back to the filtered range, the results are incomprehensible to me.
Here's my code:
Sub test()
Dim rangecopy() As Variant
rangecopy() = Range(Cells(2, 1), Cells(14, 3)).Value
For c = LBound(rangecopy, 1) To UBound(rangecopy, 1)
rangecopy(c, 1) = c
rangecopy(c, 2) = c * 10
rangecopy(c, 3) = c * 100
Next
Range(Cells(2, 1), Cells(14, 3)).Value = rangecopy()
End Sub
It is supposed to give the following result. Here, the range was unfiltered when the macro copied the array to it.
If the range is filtered by column D ("NO" is filtered out), the result looks like this:
First, the filtered cells aren't updated. Then, most cells from column B get values from the array's first column (4, 5, 6), while a few others get values from the array's second column correctly (10). The last two rows are filled with #N/A error. Is this supposed to work that way? I'm using Office 2010.
I really hope someone with knowledge of the internal workings of VBA can provide more insight on your question. I can share the following:
First, it is working as intended. However, I don't know why this is the design, nor what exactly is happening in the assignment process.
There are many cases that create a similar issue. For instance, if you have the filter on (some rows are hidden) and try to fill (drag) a formula down, you will see similar results, in that hidden rows aren't populated, but they do affect the (relative) references in the formula. On the other hand, if you manually copy and paste into a filtered range, the data is pasted into the hidden rows (as you intend).
It seems that any range referenced that is part of the Autofilter range is actually non-contiguous*. Using Range.Address does not always reveal this, nor does looping through Range.Areas. If we modify your example, we can see where the "real" error is:
Dim r1 as range
Dim r2 as range
Set r1 = Sheet1.Range("A1:B5") 'some numbers in a range
Set r2 = Sheet2.Range("A2:B6") 'same-size range underneath a filtered header
r1.Copy Destination:=r2
It works when all the rows are visible. When the filter on Sheet2 creates hidden rows, the result is "Run-time error '1004': ...the Copy area and the paste area are not the same size and shape." On the other hand, using the "manual" / clipboard method works for hidden rows:
r1.Copy
r2.PasteSpecial (xlPasteValues)
Since assigning an array to a range bypasses the clipboard (as in the 1st block), we ought to receive an error (instead you just end up with erroneous results).
The only solutions I'm aware of are to either loop through the range and assign a value to each cell:
For i = 1 to LastRow
For j = 1 to LastCol
Sheet1.Cells(i,j).Value = myArr(i,j)
Next
Next
OR (better) remove the Autofilter, assign the array to the range, then reapply the filter.
*technically it's contiguous, so it may be better to say that the range is composed of several ranges/areas, although using .Address doesn't indicate this and there is only one area when you try to loop through Range.Areas