mcallaghan
New Member
- Joined
- May 3, 2013
- Messages
- 19
Hi Guys,
I have a doc with various different sheets with records that all have an individual ID. These all relate to a central sheet "Actions" that has records that relate to one or more of the records in the other sheets through a Column G that's called "relating to ID".
What I want is to select a cell in column G and click on a macro to copy out all the records recorded in that ID.
I've got it to work if there is only one ID in the related to column with code like this:
Sub Find_Related()
Dim a As Worksheet, b As Worksheet
Set a = Sheets("Target Operating Model")
Set b = Sheets("Related Actions")
Set c = Sheets("Risks")
Dim x As Integer
Dim Cell As Range
x = 1
For Each Cell In a.Range("A1:F1000")
If Cell.Value = ActiveCell.Value Then
x = x + 1
b.Rows(x).Value = Cell.EntireRow.Value
End If
Next
For Each Cell In c.Range("A1:F1000")
If Cell.Value = ActiveCell.Value Then
x = x + 1
b.Rows(x).Value = Cell.EntireRow.Value
End If
Next
ActiveWorkbook.Sheets("Related Actions").Select
End Sub
I'm happy with this code, but the problem is when the ActiveCell is not "CP002-M001", referencing a single record, but something like "CP002-M001, CP-R002, CP004-M003". I'd like it to copy the records
CP002-M001
CP-R002
CP004-M003
Into three separate rows on the new sheet "Related Actions"
Any ideas how? This is giving me a headache!
I have a doc with various different sheets with records that all have an individual ID. These all relate to a central sheet "Actions" that has records that relate to one or more of the records in the other sheets through a Column G that's called "relating to ID".
What I want is to select a cell in column G and click on a macro to copy out all the records recorded in that ID.
I've got it to work if there is only one ID in the related to column with code like this:
Sub Find_Related()
Dim a As Worksheet, b As Worksheet
Set a = Sheets("Target Operating Model")
Set b = Sheets("Related Actions")
Set c = Sheets("Risks")
Dim x As Integer
Dim Cell As Range
x = 1
For Each Cell In a.Range("A1:F1000")
If Cell.Value = ActiveCell.Value Then
x = x + 1
b.Rows(x).Value = Cell.EntireRow.Value
End If
Next
For Each Cell In c.Range("A1:F1000")
If Cell.Value = ActiveCell.Value Then
x = x + 1
b.Rows(x).Value = Cell.EntireRow.Value
End If
Next
ActiveWorkbook.Sheets("Related Actions").Select
End Sub
I'm happy with this code, but the problem is when the ActiveCell is not "CP002-M001", referencing a single record, but something like "CP002-M001, CP-R002, CP004-M003". I'd like it to copy the records
CP002-M001
CP-R002
CP004-M003
Into three separate rows on the new sheet "Related Actions"
Any ideas how? This is giving me a headache!