mike guest98
New member
- Joined
- Jun 6, 2018
- Messages
- 28
- Reaction score
- 0
- Points
- 0
- Excel Version(s)
- 2010
Right now the code works perfectly but I would like to add one more function. The code finds all matching number(s) entered in the A1 cell, then copies and pastes the cell contents to the right of it. I would to add copying and pasting to also post the same information in only one the following cells: C17, C18, E17 OR E18. Also, have the code copy and paste the number in the cell below the matching number (from cell A1, see sample result below) into the following cells: B17, B18, D17 or D18. I have some code to do this if you like to see it please advise.
Example with expected result
So as per my sample Excel image. Number 8 was entered in cell A1 and found 8 in cell A34. So 8-15 would be copied and pasted to J8 and C17. It would also copy the number 7 from cell A35 to cell B17. The code would also do the same for cell E20. After all the copying and pasting the cell B34 must be deleted. Same for E20, F20 and G20. I hope this is clear, if not please advise and I will clarify.
<Sub do_it()>
<Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range>
<Set sht = ActiveSheet>
<n = sht.Range("A1")>
<For Each cell In sht.Range("A15:A30,C15:C30,E15:E30,G15:G30,I15:I30").Cells>
<tmp = cell.Offset(0, 1).Value>
<If cell.Value = n And tmp Like "*#-#*" Then>
< 'get the first number>
<num = CLng(Trim(Split(tmp, "-")(0)))>
<Debug.Print "Found a positive result in " & cell.Address>
<'find the next empty cell in the appropriate row>
<Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)>
<'make sure not to add before col L>
<If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)>
<cell.Offset(0, 1).Copy rngDest>
<End If>
<Next>
<End Sub>
Example with expected result
So as per my sample Excel image. Number 8 was entered in cell A1 and found 8 in cell A34. So 8-15 would be copied and pasted to J8 and C17. It would also copy the number 7 from cell A35 to cell B17. The code would also do the same for cell E20. After all the copying and pasting the cell B34 must be deleted. Same for E20, F20 and G20. I hope this is clear, if not please advise and I will clarify.
<Sub do_it()>
<Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range>
<Set sht = ActiveSheet>
<n = sht.Range("A1")>
<For Each cell In sht.Range("A15:A30,C15:C30,E15:E30,G15:G30,I15:I30").Cells>
<tmp = cell.Offset(0, 1).Value>
<If cell.Value = n And tmp Like "*#-#*" Then>
< 'get the first number>
<num = CLng(Trim(Split(tmp, "-")(0)))>
<Debug.Print "Found a positive result in " & cell.Address>
<'find the next empty cell in the appropriate row>
<Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)>
<'make sure not to add before col L>
<If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)>
<cell.Offset(0, 1).Copy rngDest>
<End If>
<Next>
<End Sub>