Code help?

[Todd_M]

Hi

The code below finds a date using the caledar control on sheet1 , then finds the first set of 7 cells on sheet1 and pastes that info on sheet3.range("a:h"). Works great thanks to Jay's help. Now If I want to paste the next set of 7 cells from sheet1 to sheet3 then I have to rewrite some of the code so that the next line on sheet3(row2) contains the next set of info. This works great also!


Private Sub CommandButton1_Click()
Sheets("sheet1").Activate
For Each a In Worksheets("sheet1").Range("d2:d10000")
If a.Value = ListBox1.Value Then
a.Offset(0, 0).Activate

Dim lastrow As Long, rng As Range

lastrow = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
With ActiveSheet
Set rng = ActiveCell.Offset(0, 7).Resize(,
End With
rng.Copy Sheets("Sheet3").Cells(lastrow + 1, 1)


lastrow = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
With ActiveSheet
Set rng = ActiveCell.Offset(0, 15).Resize(,
End With
rng.Copy Sheets("Sheet3").Cells(lastrow + 1, 1)




End If
Next a

Sheets("sheet3").Activate


End Sub



Heres the problem- if I have 29 sets of info to be pasted from sheet1 to sheet3, do I have to rewrite this code 29 times or is there an easier way to do this??

[Jay Petrulis]

On 2002-04-23 15:48, Todd_M wrote:
->snip<-

Heres the problem- if I have 29 sets of info to be pasted from sheet1 to sheet3, do I have to rewrite this code 29 times or is there an easier way to do this??

No, never rewrite the code 29 times. Put the pasting code in another loop within the "For each a" loop....

For x = 7 to 239 step 8

lastrow = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
With ActiveSheet
Set rng = ActiveCell.Offset(0, x).Resize(,8)
End With
rng.Copy Sheets("Sheet3").Cells(lastrow + 1, 1)

Next x

[Todd_M]

Jay you are a GOD-Thankyou so much, now there two small ajustments to add on to make this work.

Private Sub CommandButton1_Click()
Sheets("sheet1").Activate
For Each a In Worksheets("sheet1").Range("d2:d10000")
If a.Value = ListBox1.Value Then
a.Offset(0, 0).Activate

Dim lastrow As Long, rng As Range
For x = 7 To 239 Step 8
lastrow = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
With ActiveSheet
Set rng = ActiveCell.Offset(0, x).Resize(,
End With
rng.Copy Sheets("Sheet3").Cells(lastrow + 1, 1)

Next x
End If
Next a


First: The code reads column d in sheet1 for a date that was selected from a listbox. Then it move to the 7th cell and pastes on sheet3 to the next empty cell. Now lets say if I need to also show the date in the first column of sheet3 just to the left of each set of pastes from sheet1. I could also show it on the right of each set of pastes on sheet3(column I), but I would perfere to read a date first then the set of pastes. I know the date is listed as offset(0, 0), but im not sure how to aplly it to this wonderful code!

Secound: The code not only has to read 29 times across, but between 28 to 31 rows down depending on how many days are in the month that is selected for viewing.

I hope im not asking to much, thankyou so much.

[Jay Petrulis]

On 2002-04-23 16:26, Todd_M wrote:

...snip...

First: The code reads column d in sheet1 for a date that was selected from a listbox. Then it move to the 7th cell and pastes on sheet3 to the next empty cell. Now lets say if I need to also show the date in the first column of sheet3 just to the left of each set of pastes from sheet1. I could also show it on the right of each set of pastes on sheet3(column I), but I would perfere to read a date first then the set of pastes. I know the date is listed as offset(0, 0), but im not sure how to aplly it to this wonderful code!

Secound: The code not only has to read 29 times across, but between 28 to 31 rows down depending on how many days are in the month that is selected for viewing.

I hope im not asking to much, thankyou so much.

For the first question, will the following work for you? It should place the date in column A, with the pasted data to Column B and beyond.

Private Sub CommandButton1_Click()
Sheets("sheet1").Activate
For Each a In Worksheets("sheet1").Range("d2:d10000")
If a.Value = ListBox1.Value Then
a.Offset(0, 0).Activate

Dim lastrow As Long, rng As Range
For x = 7 To 239 Step 8
lastrow = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
With ActiveSheet
Set rng = ActiveCell.Offset(0, x).Resize(,8)
End With
Sheets("Sheet3").cells(lastrow+1,1) = a.value
rng.Copy Sheets("Sheet3").Cells(lastrow + 1, 2)

Next x
End If
Next a

I don't understand your second question. You are selecting a date and copying the data. Is the date just the first of any particular month? Do you then have to load the rest of the month's values? In what order?

This shouldn't be difficult, either. You may have to set a reference to the analysis toolpak in your VBE (Tools>References>atpvbaen) and then you can use
=DAY(EOMONTH(a.value)) to find the number of days to throw into a third loop. The is easier than writing the non-ATP function.

This multiple looping is quite slow, I'm sure.

HTH,
Jay