VAB to copy cell values into new Sheet, Overwrite if needed and based off of Cell Value in a column

[gumby]

I have two sheets. Sheet1 and Sheet2

On sheet1 I have some finaical numbers that run. For instance I want
to run a particulay day of data and it returns certain values. I would
like to be able to click a command button and have the data copied to
sheet2 into certain cells in a column based of the day of the week.
For instance if B2 on Sheet 1 Equals Monday I want it to find the
column on sheet2 that has Monday in it and copy certain cells from
sheet1 into certain cells in sheet two under that column.

Thanks,

David

 

[Guest]

Based strictly on your description, this would be a start.

set rng = Worksheets("Sheet2").Cells.Find( _
worksheets("Sheet1").Range("b2"))
set rng1 = Worksheets("Sheet2").Range("CertainCells").EntireRow
set rng2 = Intersect(rng1,rng.EntireColumn)
j = 0
for each cell in Worsheets("Sheet1").Range("Data")
j = j + 1
i = 0
for each cell1 in rng2
i = i + 1
if i = j then
cell1 = cell
exit for
end if
Next cell1
Next cell

 

[Guest]

Debug this. The premise is correct. Just insert a value in B2 and put the
string 'Monday' somewhere in the 10x10 block in sheet 2 and the program will
search for it in sheet 2 and place the B2 contents right below it.

Private Sub CommandButton1_Click()

Dim Monday As Double
Dim i, j As Integer

Monday = Worksheets(1).Cells(2, 1).Value

For i = 1 To 10
For j = 1 To 10
If Worksheets(2).Cells(i, j).Value = "Monday" Then
Worksheets(2).Cells(i, (j + 1)).Value = Monday
End If
Next
Next
End Sub

 

[gumby]

Debug this. The premise is correct. Just insert a value in B2 and put the
string 'Monday' somewhere in the 10x10 block in sheet 2 and the program will
search for it in sheet 2 and place the B2 contents right below it.

Private Sub CommandButton1_Click()

Dim Monday As Double
Dim i, j As Integer

Monday = Worksheets(1).Cells(2, 1).Value

For i = 1 To 10
For j = 1 To 10
If Worksheets(2).Cells(i, j).Value = "Monday" Then
Worksheets(2).Cells(i, (j + 1)).Value = Monday
End If
Next
Next
End Sub






- Show quoted text -

It places 0 to the right of it.

 

[gumby]

Based strictly on your description, this would be a start.

set rng = Worksheets("Sheet2").Cells.Find( _
worksheets("Sheet1").Range("b2"))
set rng1 = Worksheets("Sheet2").Range("CertainCells").EntireRow
set rng2 = Intersect(rng1,rng.EntireColumn)
j = 0
for each cell in Worsheets("Sheet1").Range("Data")
j = j + 1
i = 0
for each cell1 in rng2
i = i + 1
if i = j then
cell1 = cell
exit for
end if
Next cell1
Next cell

--
Regards,
Tom Ogilvy






- Show quoted text -

It appears to run, I get nor errors, but it does not work. The cells
are not copied.

Private Sub CommandButton1_Click()

Set rng = Worksheets("1hr_Interval_Totals").Cells.Find( _
Worksheets("1hr_Intervals").Range("D59"))
Set rng1 = Worksheets("1hr_Interval_Totals").Range("C5:O5").EntireRow
Set rng2 = Intersect(rng1, rng.EntireColumn)
j = 0
For Each cell In Worksheets("1hr_Intervals").Range("D5258")
j = j + 1
i = 0
For Each cell1 In rng2
i = i + 1
If i = j Then
cell1 = cell
Exit For
End If
Next cell1
Next cell

End Sub