Pasting in a unique row for each unique date

  • Thread starter Thread starter sowetoddid
  • Start date Start date
S

sowetoddid

Sheet1 performs a series of calculations everytime and "event" occurs.
Each "event" will always occur on a unique date. However, the even
does not occur every day.

The goal is for the user to type the event data into the input section
on sheet1. Upon pushing a command button (ie "calculate"), the input
will be run through the calculations and outputs pasted into a uniqu
row on sheet2. Each time a unique date is put in the inputs section
the next row on sheet2 will be pasted with data associated with tha
date.


Is there a VB code capable of doing this?


Thanks
 
I am sure VB code can be written that is capable of doing this.

Any code would have to be set up to be specific to your layout, so not much
can be offered beyond the above.
 
This is the code that I am try to work with...

Sub BlowdownVolume()

Range("D22").Select
ActiveCell.FormulaR1C1 = _

"=1.96*(R[-16]C[1]+14.7)*(R[-4]C[-2]^2)*R[-15]C[-2]*1000/(R[-3]C[-2]*10^6)"
Range("F23").Select
Selection.NumberFormat = "#,##0"
Selection.Copy
Sheets("Blowdown Log").Select
Range("F5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Range("F5").Select
End Sub


The code above is taking the user inputs and calculating one of th
outputs by pasting the formula into the specified cell. The result
are then pasted into the appropriate cell on the Blowdowns sheet. Thi
basic operation will be repeated for each of the ouput calculations.

The first operation should be to compare the inputted date on sheet
with the previously pasted dates on the "blowdown log". If the curren
input is already listed, then it writes over it with the most recen
outputs. If the date is not shown on "blowdown log", then the mos
recent outputs should be pasted on the first available row on th
"Blowdown log"
 
Hopefully this will make it a little more clear...


Sub Calculate()


' Begin pasting formulas to calculate the outputs on sheet1
Range("D22").Select
ActiveCell.FormulaR1C1 = _
"=1.96*(R[-15]C+14.7)*(R[-3]C^2)*R[-14]C*1000/(R[-2]C*10^6)"
Range("D23").Select
ActiveCell.FormulaR1C1 = _

"=1.96*(R[-16]C[3]+14.7)*(R[-4]C^2)*R[-15]C*1000/(R[-3]C*10^6)"
Range("D25").Select
ActiveCell.FormulaR1C1 = _
"=0.75*R[-21]C*1000*R[-5]C*60/((R[-6]C^2)*(R[-18]C+14.45)*24)"
Range("D27").Select
ActiveCell.FormulaR1C1 = "=R[-2]C*60/5280"
Range("D29").Select
ActiveCell.FormulaR1C1 = "=R[-21]C/R[-2]C"
Range("D31").Select
ActiveCell.FormulaR1C1 = "=R[-23]C*5280*3.14*7.484348/(4*144*42)"
' End pasting formulas

' (Insert code to evaluate existing dates on "Blowdown Log" and compar
with the current date in D3 of Sheet1)

' Copy the date input from sheet1
Range("D3").Select
Selection.Copy

' Insert code for locating the first available row and/or code to past
over a duplicate date (determined from evaluation performed previously)

' Paste the date into the first available row in Column A of sheet1.
Sheets("Blowdown Log").Select
Range("A5").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
'Begin a series of copying and pasting the outputs from sheet1 int
Blowdown log. !!These should all be pasted in the row corresponding t
the date!!
Range("B5").Select
Sheets("Sheet1").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Range("C5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Range("D5").Select
Sheets("Sheet1").Select
Range("D8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Range("E5").Select
Sheets("Sheet1").Select
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Range("F5").Select
Sheets("Sheet1").Select
Range("G7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Application.CutCopyMode = False
Sheets("Sheet1").Select
Selection.Copy
Sheets("Blowdown Log").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Range("G5").Select
Sheets("Sheet1").Select
Range("D22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Range("H5").Select
Sheets("Sheet1").Select
Range("D23").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
'End series of copying and pasting outputs
'Insert a final formula into "Blowdown Logs"
Range("I5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
'Format numbers
Range("G5:I5").Select
Selection.NumberFormat = "#,##0"
End Su
 
assume the date to find is in D21
and in column A of the blowdown log

Dim rng as Range
Dim res as Variant
With worksheets("BlowDown Log")
set rng = .Range(.cells(1,1),.cells(1,1).End(xldown))
End with
res = Application.Match(clng(Range("D21")),rng,0)
if not iserror(rng) then
Range("F23").copy
rng(res).offset(0,5).Pastespecial xlValues
else
rng.offset(rng.rows.count,0).Resize(1,1).Value = Range("D21")
rng.offset(rng.rows.count,0).Resize(1,1).offset(0,5).PasteSpecial xlValues
end if
 
The code is generating a Type 13 mismatch error. Any ideas. Microsof
suggests that this problem comes from comparing with String, but th
code you provided is using Variant, so that should be fine....I am jus
guessing. Please help.

The error occurs on the following line...

rng(res).offset(0,5).PasteSpecial xlValues



Thank
 
This is what I have now...Any ideas on the Error Type Mismatch

' Begin pasting formulas to calculate the outputs on Pipelin
Blowdowns
Range("D22").Select
ActiveCell.FormulaR1C1 = _
"=1.96*(R[-15]C+14.7)*(R[-3]C^2)*R[-14]C*1000/(R[-2]C*10^6)"
Range("D23").Select
ActiveCell.FormulaR1C1 = _

"=1.96*(R[-16]C[3]+14.7)*(R[-4]C^2)*R[-15]C*1000/(R[-3]C*10^6)"
Range("D25").Select
ActiveCell.FormulaR1C1 = _
"=0.75*R[-21]C*1000*R[-5]C*60/((R[-6]C^2)*(R[-18]C+14.45)*24)"
Range("D27").Select
ActiveCell.FormulaR1C1 = "=R[-2]C*60/5280"
Range("D29").Select
ActiveCell.FormulaR1C1 = "=R[-21]C/R[-2]C"
Range("D31").Select
ActiveCell.FormulaR1C1 = "=R[-23]C*5280*3.14*7.484348/(4*144*42)"
' End pasting formulas

' Code to evaluate existing dates on "Blowdown Log" and compare wit
the current date in D3 of "Pipeline Blowdowns")
' Code for locating the first available row and/or code to paste over
duplicate date (determined from evaluation performed previously)

Dim rng As Range
Dim res As Variant
With Worksheets("Blowdown log")
Set rng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
End With
res = Application.Match(CLng(Range("D21")), rng, 0)
If Not IsError(rng) Then
Range("F23").Copy
rng(res).Offset(0, 5).PasteSpecial xlValues
Else
rng.Offset(rng.Rows.Count, 0).Resize(1, 1).Value = Range("D21")
rng.Offset(rng.Rows.Count, 0).Resize(1, 1).Offset(0
5).PasteSpecial xlValues
End If

' Paste the date into the first available row in Column A of "Pipelin
Blowdowns".
Sheets("Blowdown Log").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
'Begin a series of copying and pasting the outputs from Pipelin
Blowdowns into Blowdown log. !!These should all be pasted in the ro
corresponding to the date!!
Range("B5").Select
Sheets("Pipeline Blowdowns").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Range("C5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Range("D5").Select
Sheets("Pipeline Blowdowns").Select
Range("D8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Range("E5").Select
Sheets("Pipeline Blowdowns").Select
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Range("F5").Select
Sheets("Pipeline Blowdowns").Select
Range("G7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Application.CutCopyMode = False
Sheets("Pipeline Blowdowns").Select
Selection.Copy
Sheets("Blowdown Log").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Range("G5").Select
Sheets("Pipeline Blowdowns").Select
Range("D22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Range("H5").Select
Sheets("Pipeline Blowdowns").Select
Range("D23").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blowdown Log").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
'End series of copying and pasting outputs
'Insert a final formula into "Blowdown Logs"
Range("I5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
'Format numbers
Range("G5:I5").Select
Selection.NumberFormat = "#,##0"
End Su
 
there is a typo in the code:

Dim rng as Range
Dim res as Variant
With worksheets("BlowDown Log")
set rng = .Range(.cells(1,1),.cells(1,1).End(xldown))
End with
res = Application.Match(clng(Range("D21")),rng,0)
if not iserror(res) then ' < == correction made
Range("F23").copy
rng(res).offset(0,5).Pastespecial xlValues
else
rng.offset(rng.rows.count,0).Resize(1,1).Value = Range("D21")
rng.offset(rng.rows.count,0).Resize(1,1).offset(0,5).PasteSpecial xlValues
end if
 
PasteSpecial Method of Range Class failed in this line...


rng.Offset(rng.Rows.Count, 0).Resize(1, 1).Offset(0, 5).PasteSpecia
xlValues


What do you think
 
I didn't follow the thread, but it looks like there's nothing copied that can be
pasted as values:

If Not IsError(res) Then ' < == correction made
Range("F23").Copy
rng(res).Offset(0, 5).PasteSpecial xlValues
Else
rng.Offset(rng.Rows.Count, 0).Resize(1, 1).Value = Range("D21")
Range("F23").Copy 'F23 or something else?????
rng.Offset(rng.Rows.Count, 0).Resize(1, 1).Offset(0, 5).PasteSpecial xlValues
End If
 
why can't Range("F23") be pasted as values after it is copied?

even a blank cell can be pastespecial xlvalues

ActiveCell.ClearContents
ActiveCell.Copy
activeCell.Offset(0,1).PasteSpecial xlvalues

But F23 isn't empty. He wants to add it to a row if there is a match or add
it at the bottom if there isn't
 
Dim rng as Range
Dim res as Variant
With worksheets("BlowDown Log")
set rng = .Range(.cells(1,1),.cells(1,1).End(xldown))
End with
res = Application.Match(clng(Range("D21")),rng,0)
if not iserror(res) then ' < == correction made
Range("F23").copy
rng(res).offset(0,5).Pastespecial xlValues
else
rng.offset(rng.rows.count,0).Resize(1,1).Value = Range("D21")
rng.offset(rng.rows.count,0).Resize(1,1).offset(0,5).PasteSpecial xlValues
end if

F23 was only copied in the true part of the if statement.

I wasn't sure if F23 was supposed to be copied all the time (moving it before
the "If") or if it was a different cell to be copied. So I just added another
line.

Tom said:
why can't Range("F23") be pasted as values after it is copied?

even a blank cell can be pastespecial xlvalues

ActiveCell.ClearContents
ActiveCell.Copy
activeCell.Offset(0,1).PasteSpecial xlvalues

But F23 isn't empty. He wants to add it to a row if there is a match or add
it at the bottom if there isn't
Click to expand...
 
I apologize for not getting back sooner. Let me try to explain thi
with out all of the code...

Two spreadsheets

1. "Blowdown Log" = Columns A through H have headings and starting a
row 5, each of those rows will be filled with data from the "Pipelin
Blowdowns" sheet.

2. "Pipeline Blowdowns" = There are several inputs and calculations o
this page. Six inputs and two calculated numbers will be pasted int
the "Blowdown Log" sheet. The following list is an example of wha
should be pasted... (The first column represents cells on th
"Pipeline Blowdowns" sheet.)

D3 to A5 - date cells
D2 to B5 - project name
D5 to C5
D8 to D5
D7 to E5
G7 to F5
D22 to G5
D23 to H5

Rather than have the routine of matching the date and determining wher
to paste the data, what code would be necessary to have the data o
"Pipeline Blowdowns" pasted into the appropriate cells on row 5 o
"Blowdown log" when the command button (tied to this macro) is pressed
The next time it is pressed, even if the same values exist on "Pipelin
Blowdowns", the cells should be pasted on row 6. The macro shoul
search "Blowdown Log" and determine the next empty row. This row i
where I would like the data to go.


Thanks.. Hope that makes more sense
 
how about this:

Option Explicit
Sub testme01()

Dim rng As Range
Dim res As Variant
Dim myFromAddresses As Variant
Dim myToColumns As Variant
Dim myRow As Long
Dim BDLogWks As Worksheet
Dim PBDWks As Worksheet
Dim iCtr As Long

Set BDLogWks = Worksheets("blowdown log")
Set PBDWks = Worksheets("Pipeline blowdowns")

myFromAddresses = Array("D3", "D2", "D5", "D8", "D7", "G7", "D22", "D23")
myToColumns = Array("a", "b", "c", "d", "e", "f", "g", "h")

If UBound(myFromAddresses) <> UBound(myToColumns) Then
MsgBox "design error--make counts in from/to match"
Exit Sub
End If

With BDLogWks
Set rng = .Range(.Cells(5, 1), .Cells(5, 1).End(xlDown))
End With

res = Application.Match(CLng(PBDWks.Range("D3").Value), rng, 0)
If IsError(res) Then
myRow = rng(rng.Cells.Count).Row + 1
Else
myRow = rng(res).Row
End If

With BDLogWks
For iCtr = LBound(myFromAddresses) To UBound(myFromAddresses)
.Cells(myRow, myToColumns(iCtr)).Value _
= PBDWks.Range(myFromAddresses(iCtr)).Value
Next iCtr
End With

End Sub
 
I have run your suggestion and the following error occurs...

"Error 1004" - "Application-defined or Object-defined error"


The debug option points to

.Cells(myRow, myToColumns(iCtr)).Value _
= PBDWks.Range(myFromAddresses(iCtr)).Value


????

What do you think?

????


Thank you for the help
 
I don't have a guess.

Maybe you could add:
debug.print myrow & "--" & mytocolumns(ictr) & "--" & myfromaddresses(ictr)

to see what shows up in the immediate window.

There was a dot in front of the cells(myrow,.... line--but I don't think that
was the problem.

If you can't find the problem, post back with your current code.
 
You must log in or register to reply here.

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Merging 2 sheets. 1
Sub to stack data n paste unique order ID lines 3
Error generating a list of unique values in range (XL2003) 2
loop to copy paste 5
Automated Copy Paste 1
macro for searching, copy and paste between sheets 2
Create Named Range for each unique value 1
Append Unique Records to Master Worksheet 5

Back
Top