how to sort data?

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

hi i have data in this form
Year Month Day of year, n DataA DataB DataC DataD DataE
97 Oct 291 111 222 333 444 555
666 777 888 999 000
97 Dec 350 123 345 456 234 456
321 232 543 432 246
654 332 569 432 234

Actually each year and month data has 12 rows each ( the example above has 2
rows and 3 rows as an example)

I would like to sort this data into another spreadsheet which already has
the data fields

Year Month Day of Year,n DataA DataB DataC DataD
96 Oct 298
.... ... ...
.... ... ...

How do i write a VBA program to search for the data in the first spreadsheet
based on the year and day_of_year, n , and copy and paste the corresponding
data to the second spreadsheet accordingly?

If i am unclear, basically, if the first field in the second spreadsheet was
96 and 298, the program will search the first spreadsheet based on 96 and
298, copy the corresponding data from 12 rows of the data fields DataA,DataB,
DataC, etc and paste this data onto the second spreadsheet at the rows with
96 and 298, and so on.

Sorry if it's confusing! Thanks if someone can help me on this!
 
Sheet to be copied to is Sheet2, sheet with data is Sheet1.


Dim rngYr as Range, rngDay as Range
Dim rng as Range, rngB as Range, rng1 as Range
Dim sAddr as String
With Worksheets("Sheet2")
set rngB = .range(.Cells(1,1),.Cells(rows.count,1).End(xlup))
End With
for each rngYr in rngB
if not isempty(rngYr) then
set rngDay = rngYr.offset(0,2)
With Worksheets("Sheet1")
set rng = .Range(.Cells(1,1),.Cells(rows.count,1).End(xlup))
End with

set rng1 = rng.find(rngYr.Value)
if not rng1 is nothing then
sAddr = rng1.Addr
do
if rng1.offset(0,2).Value = rngDay.Value
rng1.offset(0,3).Resize(12,5).copy _
Destination:=rngDay.offset(0,1)
exit do
end if
set rng1 = rng.findnext(rng1)
loop while rng1.address <> sAddr
End if
Next

Code is untested and may contain typos
 
Hi thanks for your Help! But there's a slight problem, i couldn't run it as
there's an error, "Compile Error: Next without For"

I checked and dun think there's a problem, cos you used For Each and it
ended with Next. Could you advise me on this? Thanks!
 
This worked for me (based on what I interpret your sheets to look like).

Sub Tester1()
Dim rngYr As Range, rngDay As Range
Dim rng As Range, rngB As Range, rng1 As Range
Dim sAddr As String
With Worksheets("Sheet2")
Set rngB = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each rngYr In rngB
If Not IsEmpty(rngYr) Then
Set rngDay = rngYr.Offset(0, 2)
With Worksheets("Sheet1")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

Set rng1 = rng.Find(rngYr.Value)
If Not rng1 Is Nothing Then
sAddr = rng1.Address
Do
If rng1.Offset(0, 2).Value = rngDay.Value Then
rng1.Offset(0, 3).Resize(12, 5).Copy _
Destination:=rngDay.Offset(0, 1)
Exit Do
End If
Set rng1 = rng.FindNext(rng1)
Loop While rng1.Address <> sAddr
End If
End If
Next


End Sub
 
Try the following:

Dim rngYr As Range, rngDay As Range
Dim rng As Range, rngB As Range, rng1 As Range
Dim sAddr As String
With Worksheets("Sheet2")
Set rngB = .Range(.Cells(1, 1), .Cells(Rows.Count,
1).End(xlUp))
End With
For Each rngYr In rngB
If Not IsEmpty(rngYr) Then
Set rngDay = rngYr.Offset(0, 2)
With Worksheets("Sheet1")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count,
1).End(xlUp))
End With

Set rng1 = rng.Find(rngYr.Value)
If Not rng1 Is Nothing Then
sAddr = rng1.Addr
Do
If rng1.Offset(0, 2).Value = rngDay.Value Then
rng1.Offset(0, 3).Resize(12, 5).Copy _
Destination:=rngDay.Offset(0, 1)
Exit Do
End If
Set rng1 = rng.FindNext(rng1)
Loop While rng1.Address <> sAddr
End If
End If
Next rngYr



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
 
Thanks! Works like a charm!

Tom Ogilvy said:
This worked for me (based on what I interpret your sheets to look like).

Sub Tester1()
Dim rngYr As Range, rngDay As Range
Dim rng As Range, rngB As Range, rng1 As Range
Dim sAddr As String
With Worksheets("Sheet2")
Set rngB = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each rngYr In rngB
If Not IsEmpty(rngYr) Then
Set rngDay = rngYr.Offset(0, 2)
With Worksheets("Sheet1")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

Set rng1 = rng.Find(rngYr.Value)
If Not rng1 Is Nothing Then
sAddr = rng1.Address
Do
If rng1.Offset(0, 2).Value = rngDay.Value Then
rng1.Offset(0, 3).Resize(12, 5).Copy _
Destination:=rngDay.Offset(0, 1)
Exit Do
End If
Set rng1 = rng.FindNext(rng1)
Loop While rng1.Address <> sAddr
End If
End If
Next


End Sub
Click to expand...
 
Thanks! Works like a charm too!

Chip Pearson said:
Try the following:

Dim rngYr As Range, rngDay As Range
Dim rng As Range, rngB As Range, rng1 As Range
Dim sAddr As String
With Worksheets("Sheet2")
Set rngB = .Range(.Cells(1, 1), .Cells(Rows.Count,
1).End(xlUp))
End With
For Each rngYr In rngB
If Not IsEmpty(rngYr) Then
Set rngDay = rngYr.Offset(0, 2)
With Worksheets("Sheet1")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count,
1).End(xlUp))
End With

Set rng1 = rng.Find(rngYr.Value)
If Not rng1 Is Nothing Then
sAddr = rng1.Addr
Do
If rng1.Offset(0, 2).Value = rngDay.Value Then
rng1.Offset(0, 3).Resize(12, 5).Copy _
Destination:=rngDay.Offset(0, 1)
Exit Do
End If
Set rng1 = rng.FindNext(rng1)
Loop While rng1.Address <> sAddr
End If
End If
Next rngYr



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
Click to expand...
 
Back
Top