I am having names in two cells of sheet1 (e.g. : B1 (Gina Williams) & B2 (Patrick Rafter)) and the corresponding bank statement narratives are in sheet 2 (column C) e.g: "Deposit from Gina towards rent for connaught place apt".
Now I need to search all the four partial texts available in cells B1 & B2 of sheet 1 (ie. "Gina", "Williams", "Patrick", "Rafter" in the entire column B of sheet 2. if there is a match i need to capture the corresponding column B & D value for the matching row.
SHEET1
Column A Column B Column C Column D
1 GINA WILLIAMS OUTPUT (matching col b of sheet2) OUTPUT (matching col D of sheet2)
2 PATRICK RAFTER OUTPUT (matching col b of sheet2) OUTPUT (matching col D of sheet2)
SHEET2
Column A Column B Column C Column D
1 12/7/2015 Deposit from Gina towards rent for connaught place apt 320
2 13/7/2015 Deposit from Rafter towards rent for connaught place apt 720
I have tried with vlookup, find, match (along with left, right, mid functions) functions.
You could use VBA to achieve this, but if you've not done VBA before, this might not be a good idea.
I would favour adding another column to sheet 2 when you manually enter the name from sheet 1 into each cell. In every cell of this new column, you can give the user a drop down list of all names that can be entered by using the excel ribbon>Data>Data Tools>DataValidation option.
This solution will work - so long as your bank statement is not enormous! If it is then you might want to do it differently. It also gets around the issue of two people on sheet1 having the same forename or surname, and is probably something you will be able to do quite quickly.
Once the above is done, you can simply use VLOOKUP in sheet 1 to fin the data on sheet 2.
KISS.
Harvey
I got one for you. I already tested the code. It work perfectly for me.
But, not grantee for duplicate naming , means, it can't give right result for duplicate names and duplicate deposit.
Here the code:
Sub findAndGet()
Dim sh1, sh2 As Worksheet
Dim tempRow1, tempRow2 As Integer
Dim strList() As String
Dim name As String
Dim index As Integer
'Set sheets
Set sh1 = Sheets("list")
Set sh2 = Sheets("search")
'Set the start row of Sheet1
tempRow1 = 1
'Loop all row from starRow until blank of column A in Sheet1
Do While sh1.Range("A" & tempRow1) <> ""
'Get name
name = sh1.Range("B" & tempRow1)
'Split by space
strList = Split(Trim(name), " ")
'Set the start row of Sheet2
tempRow2 = 1
'Reset flag
isFound = False
'Loop all row from startRow until blank of column A in Sheet2
Do While sh2.Range("A" & tempRow2) <> ""
For index = LBound(strList) To UBound(strList)
'If part of name is found.
If InStr(UCase(sh2.Range("C" & tempRow2)), UCase(strList(index))) > 0 Then
'Set true to search flag
isFound = True
'exit do loop
Exit Do
End If
Next index
'Increase row
tempRow2 = tempRow2 + 1
Loop
'If record is found, set output
If isFound Then
'set date
sh1.Range("C" & tempRow1) = sh2.Range("B" & tempRow2)
'set amount
sh1.Range("D" & tempRow1) = sh2.Range("D" & tempRow2)
End If
'Increase row
tempRow1 = tempRow1 + 1
Loop
End Sub
Related
I'm trying to have a program that can read a range of cells which consist of 12 cells (let's say: P79, R79, T79, V79, X79, Z79, AB79, AD79, AF79, AH79, AJ79, AL79) and under those cells there are 6 cells (let's say: V81, X81, Z81, AB81, AD81, AF81), the program is looking for whether or not there are values typed in the cells within the described range.
The program should be able to read the cells from left to right on the top row and loop down to the bottom row and read that from right to left.
If all the cells in the top row have values in them, then the program breaks and doesn't read the values in the bottom row.
As the program reads the values from each cell it should create a table consisting of three columns (let's say: M88, N88, O88), the leftmost column should have the cell number (in order of cell as read by the program (whichever cell has a value first in the loop is given the number 1 and then the next cell to have a value is given number 2 etc.). The middle column should have whatever value is written in it's corresponding cell read from the range. The right column should have the value of whatever is to the right of each cell containing a value.
The first value to be read with a value should give the value "Left End" and the last value to read (whether or not it is the 12th cell to have a value in the top row or the leftmost cell to have a value in the bottom row) should give the value "Right end".
An example of what a row from the table could look like:
Cell # Cell Value Position/Left/Right
1 First Left End
This is the code I have so far:
Sub Code()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Integer, j As Integer, k As Integer
' First loop to compare a car to the rest after it
For i = 1 To 12
For j = i + 1 To 12
If Not IsEmpty(ws.Range("Cell_" & i)) And Not IsEmpty(ws.Range("Cell_" & j)) Then
ws.Range("B82").Offset(i).Value = j
Exit For
End If
Next j
Next i
' Loop backwards to find "Right End"
For k = 12 To 2 Step -1 '24 To 2
If Not IsEmpty(ws.Range("Cell_12")) Then
ws.Range("B82").Offset(12).Value = "Right End"
Exit For
' Has the "Right End" Follow when cars are left blank for lower row
ElseIf IsEmpty(ws.Range("Cell_" & k)) And Not IsEmpty(ws.Range("Cell_" & k - 1)) Then
ws.Range("B82").Offset(k - 1).Value = "Right End"
Exit For
End If
Next k
What I have here merely inserts a count into a cell range, what I'm trying to do is have my code actually read the cells in the range in the order I described and one at a time look at which cells have values written in them and look at which cells (with values in them) are to the right of any cell with a value and produce the table described above.
After reading your explanation, which was quite challenging I tried to recreate what you are asking.
I used cells A1:L1 with numbers 1 to 12. in the row below that A2:L2, some numbers have been added. with an if value <> "" you can see which cells contain a value.
In the second worksheet the table is made:
Sub test()
Dim a As Integer
Dim i As Integer
Dim name As String
ActiveWorkbook.Sheets(1).Activate
a = 1
For i = 1 To endcel
If Sheets(1).Range("a1").Offset(a, i - 1).Value <> "" Then
name = Sheets(1).Range("A1").Offset(a, i - 1).Value
Sheets(2).Activate
Sheets(2).Range("b2").Offset(i).Value = name
End If
Next i
End Sub
Does this help? You can adapt it a bit to your problem.
Good luck!
Is it possible to transfer specific data from one worksheet to another?
What I want to do is to find all the data that has a specific string and transfer it to other worksheet. For example, I want to find data that has AC in it using the MID function, without any regards to its column and row, and transfer it to another worksheet.
So far, all I know is you need to have a specific range just like this code for it to work:
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For Each MyCell In Range("E2:E" & LastRow)
MyCell.Value = Mid(Range("A" & MyCell.Row), 6, 2)
Next
But the thing is it only searches a certain column, what I want is to search all the data inside a worksheet. Is this possible?
The main idea is to find / search something in this worksheet that correspond to a certain criteria.
get the data.
transfer it to another worksheet.
Something like this might help you out. You may have to tweak it to your suitability.
Sub TransferAC()
Dim C As Range
For Each C In Worksheets("Sheet1").Range("A1:B3").Cells
If InStr(1, LCase(C.Value), "ac", vbTextCompare) > 0 Then
Worksheets("Sheet2").Range(C.Address).Value = C.Value
End If
Next
End Sub
To test this, create Sheet1 like so (and create an empty Sheet2):
A B
1 testing racing
2 fencing dashing
3 pacing sleeping
When you run the procedure, Sheet2 will have
A B
1 racing
2
3 pacing
EDIT
If columns and rows are unknown but we know that they start from A1, simulate doing CTRL+DOWN-arrow-key to get the last non-empty cell in the same column and CTRL+RIGHT-arrow-key from A1 to get the last non-empty cell to the right. That will be assumed as the non-empty range.
Sub TransferAC()
Dim RangeString As String
Worksheets("Sheet1").Select
Range("A1").End(xlDown).Select
RangeString = Selection.Address
Range("A1").End(xlToRight).Select
RangeString = RangeString & ":" & Selection.Address
Dim C As Range
For Each C In Worksheets("Sheet1").Range(RangeString).Cells
If InStr(1, LCase(C.Value), "ac", vbTextCompare) > 0 Then
Worksheets("Sheet2").Range(C.Address).Value = C.Value
End If
Next
End Sub
The other alternative is to give range from A1:XFD1048576 (all cells), but that may become impractical to use.
The below mentioned data is for door access in a company where in we need to find the number of hours spent by a employee in office.
A employee can come in the office and swipe in and swipe out multiple times and all these details are register in the excel in non sorted order for all the employees.
I have a excel containing multiple columns
First two columns A,B are merged cells having date in this format(2015/01/25 7:27:30 PM).
The third column C has Access information having multiple entries for the below values(Entry/Exit).
For example
Column A Column B Access Employee ID Employee Name
==================================================
1. 2015/01/25 7:27:30 AM Entry 111 XYZ
2. 2015/01/25 7:30:30 AM Entry 333 ABC
3. 2015/01/25 8:30:30 AM Exit 111 XYZ
4. 2015/01/25 9:30:30 AM Entry 111 XYZ
5. 2015/01/25 9:30:30 AM Entry 444 PQR
6. 2015/01/25 10:30:30 Pm Exit 333 ABC
7. 2015/01/26 7:30:30 AM Exit 333 ABC
And so on.
Please note that the same employee can have multiple swipe in and out's throughout the day and will be clobbered among other employees information
The Goal is to as below
1) Copy the data from one sheet to another for the employees having spent time less than 9 hours for a specific day.
Here is the sample code that i have written it is work in progress
Sub HoursList()
Dim cell As Range
Dim cell1 As Range
Dim NewRange As Range
Dim NewRange1 As Range
Dim MyCount As Long
Dim ExistCount As Long
Dim ExistsCount As Boolean
Dim temp As Long
Dim MyCount1 As Long
Dim wsh As Worksheet, i As Long, lngEndRowInv As Long
Set wsh = Worksheets("Standard Door History ")
'Set cell = Range("A1")
ExistCount = 0
ExitsCount = False
MyCount = 1
MyCount1 = 1
i = 12
lngEndRowInv = wsh.Range("P" & wsh.Rows.Count).End(xlUp).Row
'----For every cell in row G on the Data sheet----'
For Each cell In wsh.Range("C12:D9085")
If cell.Value = "Entry" Then
'ExistCount = ExistCount + 1
If MyCount = 1 Then Set NewRange = cell.Offset(0, -1)
'----Sets up a new range to copy all data from the row if column in that row contains the value in question----'
Set NewRange = Application.Union(NewRange, cell.EntireRow)
MyCount = MyCount + 1
End If
Next cell
For Each cell1 In NewRange
If cell1.Value = "Mayur" Then
If MyCount1 = 1 Then Set NewRange1 = cell.Offset(0, -1)
'----Sets up a new range to copy all data from the row if column in that row contains the value in question----'
Set NewRange1 = Application.Union(NewRange1, cell.EntireRow)
MyCount1 = MyCount1 + 1
End If
Next cell1
If ExistCount > 0 Then
NewRange.Copy Destination:=Worksheets("Test").Range("A3")
End If
End Sub
Thanks
Here is a very rough version that you could use in VBA. It needs refining and error trapping, and future proofing, but it does what you want it to. It takes data from the active sheet and current adds it to the second worksheet. The date for looking up is in cell N1 of the first sheet.
Option Explicit
Sub CopyNine()
Dim LastRow As Integer
Dim DateToFind As Variant
Dim CellDate As Variant
Dim Count As Integer
Dim cel As Range
Dim DateRange As Range
Dim StaffID As String
Dim TimeStamp As Double
Dim StaffSummary As Object
Dim DS As Worksheet
Dim SS As Worksheet
Dim SSRow As Integer
LastRow = Range("A1").End(xlDown).Row
'You may wish to turn this into an input instead
DateToFind = Range("N1").Formula
Set DS = ActiveSheet
'You may wish to change this
Set SS = Sheets(2)
SSRow = 2
'Get a range containing all the correctly dated cells from the dataset
For Each cel In Range("A2:A" & LastRow).Cells
CellDate = Left(cel.Formula, InStr(1, cel.Formula, ".") - 1)
If CellDate = DateToFind Then
If DateRange Is Nothing Then
Set DateRange = cel
Else
Set DateRange = Union(DateRange, cel)
End If
End If
Next
'Create a summary dictionary of all staff IDs and their time spent in the office where 1 = 1 day
Set StaffSummary = CreateObject("scripting.dictionary")
For Each cel In DateRange.Cells
StaffID = cel.Offset(0, 3).Value
'These may need to be updated depending on your entry in the 'Entry/Exit' column
If cel.Offset(0, 2).Value = "Entry" Then
TimeStamp = -cel.Formula
Else
TimeStamp = cel.Formula
End If
If Not StaffSummary.exists(StaffID) Then
StaffSummary.Add StaffID, TimeStamp
Else
StaffSummary.Item(StaffID) = StaffSummary.Item(StaffID) + TimeStamp
End If
Next
'Copy the titles from the data sheet
SS.Range("A1:E1").Value = DS.Range("A1:E1").Value
'Copy the appropriate rows across using the dictionary you created
For Each cel In DateRange.Cells
StaffID = cel.Offset(0, 3).Value
If StaffSummary.Item(StaffID) <= 9 / 24 Then 'This is 9 hours so copy across
SS.Range("A" & SSRow & ":E" & SSRow).Value = DS.Range(cel, cel.Offset(0, 4)).Value
SSRow = SSRow + 1
End If
Next
End Sub
I would suggest using Excel's inbuilt abilities before VBA, especially if you are new to VBA. This will involve adding additional columns to your input sheet though which you can hide, but may not be ideal for your situation. It could also get quite slow as there are some large calculations, but it does depend on your original data set.
I would suggest the following (although there will be a lot of variations on it!):
1) Create a summary table for the particular day.
Create a date column in column F which is =TRUNC(A2) and copy down the table.
In M1 have your input date - e.g. 2015/01/25
In column L list all the unique Staff IDs
Below the date in M, use a SUMIFS formula and time formatting to determine how many hours each person spent. In M3 for example =SUMIFS($A:$A,$D:$D,$L2,$C:$C,"Exit",$F:$F,$M$1) - SUMIFS($A:$A,$D:$D,$L2,$C:$C,"Entry",$F:$F,$M$1) then formatting as hh:mm:ss.
In column N, use =M2<TIME(9,0,0) and drag down to work out if that individual has spent less than 9 hours in the building on that day.
You should now have a table showing all the staff and how many hours they spent in the building on that day, and a TRUE or FALSE whether they spent less than 9 hours.
2) Create your additional columns to pull the data to another sheet
In Column G, determine whether the entry is for the date in question (in cell M1) using =F2=$M$1 (should give a TRUE or FALSE)
In Column H, determine if that individual has spent less than 9 hours (from the summary table) using =INDEX(N:N, MATCH(D2, L:L,0))
In Column I, determine whether that entry should be copied across using =AND(G2, H2)
Finally in Column J, determine which entry this is to copy across using `=IF(I2, COUNTIFS($I$1:I2,TRUE),"")
Copy each of these down to the bottom of the table (you can hide them later)
3) Create your table on the next sheet for copying down - I have called my original worksheet "Data" and my second one "Copy"
In column A, use =ROW()-1 to create a sequential list of numbers
In column B, use =MATCH(A2, Data!J:J,0) to find out which row of data from the original table is being copied across
In column C, use =IFERROR(INDEX(Data!A:A,$B2),"") to pull the data from the first column
Copy this formula across to column G
Copy all of these down the sheet to however many rows of data you would like
Hide columns A, B and D since these will contain irrelevant information
You should then have an autoupdating table based on the date in cell M1 on the original data sheet. As mentioned above, this can be adapted in many ways, and it may not be ideal for your situation depending on your data set size, but it may be a start for you. If it is not suitable, then please use the theory to adapt some VBA code, as this can also be done in VBA in a very similar way.
I'm new to VBA in Excel and I'm having some trouble. I have 3 columns A, C, and F. I want to highlight only the cells in those columns if they match either of 2 conditions. Highlight any cells with duplicate values in column A, and then only highlight cells in column C and F if column C has a value of 99.99 and greater and Column F has anything but "Test" in the cell.
Sub Highlight()
Dim index As Integer
For index = 1 To 4
'Checks if any cells in Column C has value greater than 99.99 when Column F isn't "Test" or checks if multiple values exist in Column A (which I don't know)
If Range("C1") And Cell.Value > "99.99" And Range("F1") And Cell.Text <> "Current" Then
'Highlighs both cell values Yellow (this is where I run into trouble)
Cell.Interior.ColorIndex = vbYellow
End If
Next index
End Sub
You were just referring to your range wrong. Cell wasn't set. I couldn't see where you were referring to column A though.
Also, if you're using the built in color constants you should use .Color not ColorIndex.
Sub Highlight()
Dim index As Integer
Dim ws As Worksheet
'set the sheet to use
Set ws = Sheet1
For index = 1 To 4
'Checks if any cells in Column C has value greater than 99.99 when Column F isn't "Test" or checks if multiple values exist in Column A (which I don't know)
If ws.Range("C" & index).Value > "99.99" And ws.Range("F" & index).Text <> "Current" Then
'Highlighs both cell values Yellow (this is where I run into trouble)
ws.Range("C" & index).Interior.Color = vbYellow
ws.Range("F" & index).Interior.Color = vbYellow
End If
Next index
End Sub
On a side note. You may be better off looking at using Conditional formatting to achieve what you want rather than VBA.
There is a lot of tutorials about on the internet:
http://chandoo.org/wp/2009/03/13/excel-conditional-formatting-basics/
http://spreadsheets.about.com/od/advancedexcel/tp/090822-excel-conditional-formatting-hub.htm
I have an excel worksheet with whole bunch of rows and several columns in it. The 1st column contains the manufacturer's name, the 2nd column contains the product codes for all the products, the 3rd column contains the description and etc.
What I want to do is to copy the rows that corresponds to certain product codes. For example:
**Manufacturer Product code Description**
abc B010 blah blah
dgh A012
hgy X010
eut B013
uru B014
eut B015
asd G012
sof B016
uet B016
etc
Is there a way to copy the rows that has the product codes in between B010 - B016? There might be double/matching product codes too, and it is totally fine to copy them too.
Makes sense?
Sorry, i have no vba code to put in here yet.
Thanks in advance.
This should do the trick; it copies the A:C range cells for any B cell values that are between B010 and B016 to the next available row in Sheet2.
Private Sub CopyRows()
Dim lastrow As Long
Dim r1 As Long, r2 As Long
' Get the last row in the worksheet
lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
r2 = 1
For r1 = 1 To lastrow
' If the last three characters of the B cell are numeric...
If IsNumeric(Right(Sheet1.Range("$B$" & r1).Value, 3)) Then
' If the first character of the B cell is "B", and the last three
' characters are between 10 and 16 ...
If Left(Sheet1.Range("$B$" & r1).Value, 1) = "B" And _
CLng(Right(Sheet1.Range("$B$" & r1).Value, 3)) >= 10 And _
CLng(Right(Sheet1.Range("$B$" & r1).Value, 3)) <= 16 Then
' ... copy the A-C range for the row to the next available row
' in Sheet2
Sheet2.Range("$A$" & r2, "$C$" & r2).Value = _
Sheet1.Range("$A$" & r1, "$C$" & r1).Value
r2 = r2 + 1
End If
End If
Next
End Sub