Finding Number Within Range Then Copying Data Below Number to Cells

[acctemp]

Hi,

I have a report which I was able to parse data out of however the
format changed (rendering the programming useless) and I'm looking for
a better solution.

What I need to do is find a 3 digit number (not within another number,
very important) from within a range and then copy/paste information
from the cell below it and the 3 cells to the right of that one to a
range in another part of the spreadsheet. Based on the data below this
is what I would be looking for...

Find the number "101" (see exhibit "A") and then copy 74,980, 0,
22,100.00 and 52,880 to a range in another part of the same spreadsheet
(see exhibit "B").

The same process would continue for number 102, 103, 104, etc.


Exhibit A

101 Mark K Brar
74,980.00 0 22,100.00 52,880.00

102 Mark K Brar
20,580.00 18,000.00 2,070.00 36,510.00

103 Mark K Brar
3,260.63 0 0 3,260.63

104 Mark K Brar
7,759.24 4,064.00 2,105.40 9,717.84

105 Lucy Davenport 10/12/2006
9,839.04 0 0 9,839.04

106 Rebecca Smith 10/12/2006
6,855.24 5,447.00 3,401.57 8,900.67

107 Mark K Brar
3,213.70 0 3,213.70

108 Ralph Jones 8/24/2005
0 0 0 0

Exhibit B:

101 $74,980.00 $0.00 $22,100.00 $52,880.00
102 $20,580.00 $18,000.00 $2,070.00 $36,510.00
103 $3,260.63 $0.00 $0.00 $3,260.63
104 $7,759.24 $4,064.00 $2,105.40 $9,717.84
105 $9,839.04 $0.00 $0.00 $9,839.04
106 $6,855.24 $5,447.00 $3,401.57 $8,900.67
107 $3,213.70 $0.00 $0.00 $3,213.70
108 $0.00 $0.00 $0.00 $0.00

 

[Sandy]

Hey there, try this code out just paste it into a new module(in VBE) in
the workbook.
Make sure to read the comments in the code to change the ranges and the
names of the worksheets:

Sub CopyPaste()
Dim mCell, MyRange, MyCopy As Range
Dim Ws1, Ws2 As Worksheet

'Make sure you set your worksheets
'Ws1 is where your info is
'Ws2 is where you wnt the info to go
'MyRange is obviously your data range in
'Ws1
Set Ws1 = Worksheets("Sheet1")
Set Ws2 = Worksheets("Sheet2")
Set MyRange = Ws1.Range("A1:A16")

For Each mCell In MyRange
If IsNumeric(mCell) And Not _
IsNumeric(mCell.Offset(0, 1).Value) Then
Range(mCell.Offset(1, 0), mCell.Offset(1, 3)).Copy
With Ws2
.Activate
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 1).Select
End With
Selection.Offset(0, -1).Value = mCell.Value
Selection.PasteSpecial xlPasteAll
End If
Next
End Sub


Sandy

 

[acctemp]

Sandy,

Thanks for the quick and helpful reply. I'm not sure if this will
work, perhaps I didn't explain the problem well enough...

The problem with this solution is that it assumes that the range is
always the same. Unfortunately the report changes once in a while and
the numbers move. I wanted to search one large range that easily
accomodate all the data and search by number. If I don't do it this
way the system fails as it cannot tell when 201 has moved into the
position of 107 and puts the wrong data in it.

Below is the entire range where the data would be output to. What I
need is something that will search for "101" (and all the subsequent
numbers) in the whole report and then move the four numbers below it
into the appropriate fields below:




101 $0.00 $0.00 $0.00 $0.00 $- $-
102 $0.00 $0.00 $0.00 $0.00 $- $-
103 $0.00 $0.00 $0.00 $0.00 $- $-
104 $0.00 $0.00 $0.00 $0.00 $- $-
105 $0.00 $0.00 $0.00 $0.00 $- $-
106 $0.00 $0.00 $0.00 $0.00 $- $-
107 $0.00 $0.00 $0.00 $0.00 $- $-
108 $0.00 $0.00 $0.00 $0.00 $- $-

201 $0.00 $0.00 $0.00 $0.00 $- $-
202 $0.00 $0.00 $0.00 $0.00 $- $-
203 $0.00 $0.00 $0.00 $0.00 $- $-
204 $0.00 $0.00 $0.00 $0.00 $- $-
205 $0.00 $0.00 $0.00 $0.00 $- $-
206 $0.00 $0.00 $0.00 $0.00 $- $-

301 $0.00 $0.00 $0.00 $0.00 $- $-
302 $0.00 $0.00 $0.00 $0.00 $- $-
303 $0.00 $0.00 $0.00 $0.00 $- $-
304 $0.00 $0.00 $0.00 $0.00 $- $-
305 $0.00 $0.00 $0.00 $0.00 $- $-
306 $0.00 $0.00 $0.00 $0.00 $- $-
307 $0.00 $0.00 $0.00 $0.00 $- $-

401 $0.00 $0.00 $0.00 $0.00 $- $-
402 $0.00 $0.00 $0.00 $0.00 $- $-
403 $0.00 $0.00 $0.00 $0.00 $- $-
404 $0.00 $0.00 $0.00 $0.00 $- $-
405 $0.00 $0.00 $0.00 $0.00 $- $-
406 $0.00 $0.00 $0.00 $0.00 $- $-

501 $0.00 $0.00 $0.00 $0.00 $- $-
502 $0.00 $0.00 $0.00 $0.00 $- $-
503 $0.00 $0.00 $0.00 $0.00 $- $-
504 $0.00 $0.00 $0.00 $0.00 $- $-
505 $0.00 $0.00 $0.00 $0.00 $- $-
506 $0.00 $0.00 $0.00 $0.00 $- $-

601 $0.00 $0.00 $0.00 $0.00 $- $-
602 $0.00 $0.00 $0.00 $0.00 $- $-
603 $0.00 $0.00 $0.00 $0.00 $- $-
604 $0.00 $0.00 $0.00 $0.00 $- $-
605 $0.00 $0.00 $0.00 $0.00 $- $-

701 $0.00 $0.00 $0.00 $0.00 $- $-
702 $0.00 $0.00 $0.00 $0.00 $- $-
703 $0.00 $0.00 $0.00 $0.00 $- $-
704 $0.00 $0.00 $0.00 $0.00 $- $-
705 $0.00 $0.00 $0.00 $0.00 $- $-
706 $0.00 $0.00 $0.00 $0.00 $- $-

 

[Sandy]

Hey there try this code modification and see if it works

Sub UpDateCells()
Dim mCell, MyRange, MyCopy As Range
Dim Ws1, Ws2 As Worksheet
Dim mFound As Range
Set Ws1 = Worksheets("Sheet1")
Set Ws2 = Worksheets("Sheet2")
'Check the first column for the number
Set MyRange = Ws1.Range("A1:A16") ' or whatever
'the range is"

For Each mCell In MyRange
If IsNumeric(mCell) And Not _
IsNumeric(mCell.Offset(0, 1).Value) Then
Range(mCell.Offset(1, 0), mCell.Offset(1, 3)).Copy
With Ws2.Columns("A")
Set mFound = .Find _
(mCell, , LookIn:=xlValues)
End With
Ws2.Activate
mFound.Offset(0, 1).Select
Selection.PasteSpecial xlPasteAll
End If
Next
Application.CutCopyMode = False
End Sub

Let me know how this works out.

Sandy

 

[acctemp]

Thanks, I'll give it a try on Monday. I'm puzzled as to how the code
figures out where to put the results though. The data range is
B130-G400 and the output ranges are B5:E12, B22:E27, B37:E43, B53:E58,
B68:E73, B83:E87, and B100:E105. Both are on the same worksheet.

 

[acctemp]

Hi,

Tried this code but could not get it to work. The data needs to be on
the same spreadsheet and must go to designated locations. Also I got
an error "Method 'Range of Object' worksheet failed" at this
breakpoint:

Range(mCell.Offset(1, 0), mCell.Offset(1, 3)).Copy

Here is the code I have so far:

Dim mCell, MyRange, MyCopy As Range
Dim Ws1, Ws2 As Worksheet
Dim mFound As Range
Set Ws1 = Worksheets("10-16")
Set Ws2 = Worksheets("Sheet2")
'Check the first column for the number
Set MyRange = Ws1.Range("B129:E400") ' or whatever
'the range is"


For Each mCell In MyRange
If IsNumeric(mCell) And Not _
IsNumeric(mCell.Offset(0, 1).Value) Then
Range(mCell.Offset(1, 0), mCell.Offset(1, 3)).Copy
With Ws2.Columns("A")
Set mFound = .Find _
(mCell, , LookIn:=xlValues)
End With
Ws2.Activate
mFound.Offset(0, 1).Select
Selection.PasteSpecial xlPasteAll
End If
Next
Application.CutCopyMode = False
End Sub