| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Finding all matches in column B with datalist in column A
I have data from two sources being pasted into columns A, B and C of a new
spreadsheet. Column A contains the account number, B the customer name and C a description of the transaction, including the customer name. I have a routine which finds the first occurence and pasted the account number into column D but I need it to continue and do so for all occurences. I am using the following which runs perfectly for one project but needs modifying for the curent one. Sub abc() Windows("FXDH.xls").Activate Sheets("FXDH").Activate Dim rngA As Range, rngB As Range Dim rng As Range, cell As Range Dim res As Variant With Worksheets("Sheet1") Range("D:D").Select Selection.Copy Sheets("Sheet1").Activate Range("B1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Workbooks.Open ("T:\Fxbckoff\FXVolumeRpts\Customers.xls") Sheets("qryCustomers").Activate Range("A:A").Select Selection.Copy Windows("FXDH.xls").Activate Sheets("Sheet1").Activate Range("A1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Stop Set rngA = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)) Set rngB = .Range(.Cells(2, 2), .Cells(2, 2).End(xlDown)) End With For Each cell In rngA res = Application.Match("*" & cell.Value & "*", rngB, 0) If Not IsError(res) Then Set rng = rngB(res) rng.Font.Color = RGB(255, 0, 0) rng.Font.Bold = True rng.Offset(0, 1) = cell.Offset(0, 0).Value End If Next End Sub How can I modify this to find all occurences? Thanks, Jim -- Pops Jackson |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Finding all matches in column B with datalist in column A
add the dim statement
Dim sAddr as String Replace your search loop with this: For Each cell In rngA rng = rngb.Find(What:=cell.Value, _ After:=rngb(rngb.count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng is nothing Then sAddr = rng.Address do rng.Font.Color = RGB(255, 0, 0) rng.Font.Bold = True rng.Offset(0, 1) = cell.Offset(0, 0).Value set rng= rngB.FindNext(rng) Loop while rng.Address < sAddr End If Next -- Regards, Tom Ogilvy "Pops Jackson" wrote: I have data from two sources being pasted into columns A, B and C of a new spreadsheet. Column A contains the account number, B the customer name and C a description of the transaction, including the customer name. I have a routine which finds the first occurence and pasted the account number into column D but I need it to continue and do so for all occurences. I am using the following which runs perfectly for one project but needs modifying for the curent one. Sub abc() Windows("FXDH.xls").Activate Sheets("FXDH").Activate Dim rngA As Range, rngB As Range Dim rng As Range, cell As Range Dim res As Variant With Worksheets("Sheet1") Range("D:D").Select Selection.Copy Sheets("Sheet1").Activate Range("B1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Workbooks.Open ("T:\Fxbckoff\FXVolumeRpts\Customers.xls") Sheets("qryCustomers").Activate Range("A:A").Select Selection.Copy Windows("FXDH.xls").Activate Sheets("Sheet1").Activate Range("A1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Stop Set rngA = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)) Set rngB = .Range(.Cells(2, 2), .Cells(2, 2).End(xlDown)) End With For Each cell In rngA res = Application.Match("*" & cell.Value & "*", rngB, 0) If Not IsError(res) Then Set rng = rngB(res) rng.Font.Color = RGB(255, 0, 0) rng.Font.Bold = True rng.Offset(0, 1) = cell.Offset(0, 0).Value End If Next End Sub How can I modify this to find all occurences? Thanks, Jim -- Pops Jackson |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Finding all matches in column B with datalist in column A
I made the changes but am getting "Object variable or With block variable not
set." error message at the line after "For each cell in rngA". I am including the code below after the changes. Sub abc() Windows("FXDH.xls").Activate Sheets("Data").Activate Dim sAddr As String Dim rngA As Range, rngB As Range Dim rng As Range, cell As Range Dim res As Variant With Worksheets("Sheet1") ActiveSheet.Range("D:D").Select Selection.Copy Sheets("Sheet1").Activate ActiveSheet.Range("B1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Workbooks.Open ("T:\Fxbckoff\FXVolumeRpts\Customers.xls") Sheets("qryCustomers").Activate ActiveSheet.Range("A:A").Select Selection.Copy Windows("FXDH.xls").Activate Sheets("Sheet1").Activate ActiveSheet.Range("A1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Set rngA = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)) Set rngB = .Range(.Cells(2, 2), .Cells(2, 2).End(xlDown)) End With For Each cell In rngA rng = rngB.Find(What:=cell.Value, _ After:=rngB(rngB.Count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng Is Nothing Then sAddr = rng.Address Do rng.Font.Color = RGB(255, 0, 0) rng.Font.Bold = True rng.Offset(0, 1) = cell.Offset(0, 0).Value Set rng = rngB.FindNext(rng) Loop While rng.Address < sAddr End If Next End Sub Thanks -- Pops Jackson "Tom Ogilvy" wrote: add the dim statement Dim sAddr as String Replace your search loop with this: For Each cell In rngA rng = rngb.Find(What:=cell.Value, _ After:=rngb(rngb.count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng is nothing Then sAddr = rng.Address do rng.Font.Color = RGB(255, 0, 0) rng.Font.Bold = True rng.Offset(0, 1) = cell.Offset(0, 0).Value set rng= rngB.FindNext(rng) Loop while rng.Address < sAddr End If Next -- Regards, Tom Ogilvy "Pops Jackson" wrote: I have data from two sources being pasted into columns A, B and C of a new spreadsheet. Column A contains the account number, B the customer name and C a description of the transaction, including the customer name. I have a routine which finds the first occurence and pasted the account number into column D but I need it to continue and do so for all occurences. I am using the following which runs perfectly for one project but needs modifying for the curent one. Sub abc() Windows("FXDH.xls").Activate Sheets("FXDH").Activate Dim rngA As Range, rngB As Range Dim rng As Range, cell As Range Dim res As Variant With Worksheets("Sheet1") Range("D:D").Select Selection.Copy Sheets("Sheet1").Activate Range("B1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Workbooks.Open ("T:\Fxbckoff\FXVolumeRpts\Customers.xls") Sheets("qryCustomers").Activate Range("A:A").Select Selection.Copy Windows("FXDH.xls").Activate Sheets("Sheet1").Activate Range("A1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Stop Set rngA = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)) Set rngB = .Range(.Cells(2, 2), .Cells(2, 2).End(xlDown)) End With For Each cell In rngA res = Application.Match("*" & cell.Value & "*", rngB, 0) If Not IsError(res) Then Set rng = rngB(res) rng.Font.Color = RGB(255, 0, 0) rng.Font.Bold = True rng.Offset(0, 1) = cell.Offset(0, 0).Value End If Next End Sub How can I modify this to find all occurences? Thanks, Jim -- Pops Jackson |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Finding all matches in column B with datalist in column A
I have tried every way to add, modify etc to make this work but to no avail.
If anyone has an idea, I would truly appreciate hearing from you. Thanks in advance, -- Pops Jackson "Pops Jackson" wrote: I made the changes but am getting "Object variable or With block variable not set." error message at the line after "For each cell in rngA". I am including the code below after the changes. Sub abc() Windows("FXDH.xls").Activate Sheets("Data").Activate Dim sAddr As String Dim rngA As Range, rngB As Range Dim rng As Range, cell As Range Dim res As Variant With Worksheets("Sheet1") ActiveSheet.Range("D:D").Select Selection.Copy Sheets("Sheet1").Activate ActiveSheet.Range("B1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Workbooks.Open ("T:\Fxbckoff\FXVolumeRpts\Customers.xls") Sheets("qryCustomers").Activate ActiveSheet.Range("A:A").Select Selection.Copy Windows("FXDH.xls").Activate Sheets("Sheet1").Activate ActiveSheet.Range("A1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Set rngA = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)) Set rngB = .Range(.Cells(2, 2), .Cells(2, 2).End(xlDown)) End With For Each cell In rngA rng = rngB.Find(What:=cell.Value, _ After:=rngB(rngB.Count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng Is Nothing Then sAddr = rng.Address Do rng.Font.Color = RGB(255, 0, 0) rng.Font.Bold = True rng.Offset(0, 1) = cell.Offset(0, 0).Value Set rng = rngB.FindNext(rng) Loop While rng.Address < sAddr End If Next End Sub Thanks -- Pops Jackson "Tom Ogilvy" wrote: add the dim statement Dim sAddr as String Replace your search loop with this: For Each cell In rngA rng = rngb.Find(What:=cell.Value, _ After:=rngb(rngb.count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng is nothing Then sAddr = rng.Address do rng.Font.Color = RGB(255, 0, 0) rng.Font.Bold = True rng.Offset(0, 1) = cell.Offset(0, 0).Value set rng= rngB.FindNext(rng) Loop while rng.Address < sAddr End If Next -- Regards, Tom Ogilvy "Pops Jackson" wrote: I have data from two sources being pasted into columns A, B and C of a new spreadsheet. Column A contains the account number, B the customer name and C a description of the transaction, including the customer name. I have a routine which finds the first occurence and pasted the account number into column D but I need it to continue and do so for all occurences. I am using the following which runs perfectly for one project but needs modifying for the curent one. Sub abc() Windows("FXDH.xls").Activate Sheets("FXDH").Activate Dim rngA As Range, rngB As Range Dim rng As Range, cell As Range Dim res As Variant With Worksheets("Sheet1") Range("D:D").Select Selection.Copy Sheets("Sheet1").Activate Range("B1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Workbooks.Open ("T:\Fxbckoff\FXVolumeRpts\Customers.xls") Sheets("qryCustomers").Activate Range("A:A").Select Selection.Copy Windows("FXDH.xls").Activate Sheets("Sheet1").Activate Range("A1").Select ActiveCell.PasteSpecial Application.CutCopyMode = False Stop Set rngA = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)) Set rngB = .Range(.Cells(2, 2), .Cells(2, 2).End(xlDown)) End With For Each cell In rngA res = Application.Match("*" & cell.Value & "*", rngB, 0) If Not IsError(res) Then Set rng = rngB(res) rng.Font.Color = RGB(255, 0, 0) rng.Font.Bold = True rng.Offset(0, 1) = cell.Offset(0, 0).Value End If Next End Sub How can I modify this to find all occurences? Thanks, Jim -- Pops Jackson |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Maddening Dilemma - Compare each cell within column a to each cell in column b and find unique matches | Excel Worksheet Functions | |||
| column A matches f places the value from g in column b what funct | Excel Worksheet Functions | |||
| Count cells w/values in column if the data in column a matches cri | Excel Worksheet Functions | |||
| finding the largest value for a name in a column and then returningthe result from a different column | Excel Worksheet Functions | |||
| finding and reporting in column A, where a series of column reaches zero | Excel Programming | |||
Linear Mode
