Another one for the Experts

[northernstar]

hi everyone

i have a (small - to you experts) problem

i need to generate a table in a report which varies in size and position depending and a number of conditions entered in via a form, and some dat need to be entered into the rows along with some constant formula (example lookup and if or statements)

for example the table (excluding the headers) can range from 1 to 50 rows, which i do i can setup on another sheet and then copy and paste the correct number of rows which would have the relevant formulae in already. but this just seems alot of code to right for all 50 rows, thought perhaps i can use a for....next statement but not really sure how these work

hope this makes sense

thanks in advance

[northernstar]

here is a sample of the code i have done so far (very long winded especially as i need to go upto if NoRods = 50

see below

[northernstar]

Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Sheets("Certificate").Unprotect Password:="0000"

Range("Sheet1!m32") = NoRods

Range("Certificate!a12:j50,a62:j103").Select
With Selection
.ClearContents
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.UnMerge
Unload MicRods
End With

If CInt(NoRods) = 1 Then
Range("Certificate!a13") = "This gauge was measured for axial length by comparison with laboratory standards, with the following results:"
End If

If CInt(NoRods) > 1 Then
Range("Certificate!a13") = "These gauges was measured for axial length by comparison with laboratory standards, with the following results:"
End If

If BS870 = True Then
Range("Certificate!c10") = "Accuracy requirements of BS870:1950/1959"
MsgBox ("You have chosen BS870 which is for gauges upto and including 23 in & 575 mm")
End If

If BS870M = True Then
Range("Certificate!c10") = "Accuracy requirements of BS870:1950/1959 and manufacturers published accuracy figures"
MsgBox ("You have chosen BS870 & manufacturers specification which is based on the M&W tolerances and is for gauges over 23 in & 575 mm")
End If

If Manufacturer = True Then
Range("Certificate!c10") = "Manufacturers published accuracy figures"
MsgBox ("You have chosen manufacturers specification which is based on the M&W tolerances and is for gauges over 23 in & 575 mm")
End If
If Customer = True Then
Range("Certificate!c10") = "Customers specification"
MsgBox ("You have chosen customers specification, please enter the relevant tolerances")
End If

'1 Rod

If Range("Sheet1!M32") = 1 Then
Sheets("Sheet1").Select
Range("Rod1").Select
Selection.Copy
Sheets("Certificate").Select
Range("A12:J12").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("a17").Select
Sheets("Sheet1").Select
Range("i2:i10").Select
Selection.Copy
Sheets("Certificate").Select
Range("A16").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("a17").Select

If Range("Sheet1!c48") = 4 Then
Range("Certificate!f17").ClearContents
End If
End If
'2 rods

If Range("Sheet1!M32") = 2 Then
Sheets("Sheet1").Select
Range("Rod2").Select
Selection.Copy
Sheets("Certificate").Select
Range("A12:J12").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("a17").Select
Sheets("Sheet1").Select
Range("i2:i10").Select
Selection.Copy
Sheets("Certificate").Select
Range("A17").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("a17").Select

If Range("Sheet1!c48") = 4 Then
Range("Certificate!f17").ClearContents
End If
End If

'3 Rods
If Range("Sheet1!M32") = 3 Then
Sheets("Sheet1").Select
Range("Rod3").Select
Selection.Copy
Sheets("Certificate").Select
Range("A12:J12").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("a17").Select
Sheets("Sheet1").Select
Range("i2:i10").Select
Selection.Copy
Sheets("Certificate").Select
Range("A18").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("a17").Select

If Range("Sheet1!c48") = 4 Then
Range("Certificate!f17").ClearContents
End If
End If
end sub

[Bob Phillips]

You can simplify it



Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Sheets("Certificate").Unprotect Password:="0000"

Range("Sheet1!m32") = NoRods

Range("Certificate!a12:j50,a62:j103").Select
With Selection
.ClearContents
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.UnMerge
Unload MicRods
End With

If CInt(NoRods) = 1 Then
Range("Certificate!a13") = "This gauge was measured for axial length by comparison with laboratory standards, with the following results:"
End If

If CInt(NoRods) > 1 Then
Range("Certificate!a13") = "These gauges was measured for axial length by comparison with laboratory standards, with the following results:"
End If

If BS870 = True Then
Range("Certificate!c10") = "Accuracy requirements of BS870:1950/1959"
MsgBox ("You have chosen BS870 which is for gauges upto and including 23 in & 575 mm")
End If

If BS870M = True Then
Range("Certificate!c10") = "Accuracy requirements of BS870:1950/1959 and manufacturers published accuracy figures"
MsgBox ("You have chosen BS870 & manufacturers specification which is based on the M&W tolerances and is for gauges over 23 in & 575 mm")
End If

If Manufacturer = True Then
Range("Certificate!c10") = "Manufacturers published accuracy figures"
MsgBox ("You have chosen manufacturers specification which is based on the M&W tolerances and is for gauges over 23 in & 575 mm")
End If
If Customer = True Then
Range("Certificate!c10") = "Customers specification"
MsgBox ("You have chosen customers specification, please enter the relevant tolerances")
End If

'1 Rod

If Range("Sheet1!M32") = 1 Then
Call PasteData(rng1:=Sheets("Sheet1").Range("Rod1"), _
rng2:=Sheets("Certificate").Range("A16"))
ElseIf Range("Sheet1!M32") = 2 Then
Call PasteData(rng1:=Sheets("Sheet1").Range("Rod2"), _
rng2:=Sheets("Certificate").Range("A17"))
ElseIf Range("Sheet1!M32") = 3 Then
Call PasteData(rng1:=Sheets("Sheet1").Range("Rod3"), _
rng2:=Sheets("Certificate").Range("A18"))
'etc.
End If
End Sub

Sub PasteData(rng1 As Range)

rng1.Copy Sheets("Certificate").Range("A12:J12")
Sheets("Sheet1").Range("i2:i10").Copy rng2
Application.CutCopyMode = False

If Range("Sheet1!c48") = 4 Then
Range("Certificate!f17").ClearContents
End If
End Sub

[northernstar]

thanks i will do that

thanks again

[northernstar]

hi

i have just tried that code and it doesnt seem to want to excute the 'PasteData' sub

it goes to the relevant line 'Call PasteData.......'
it goes straight from this line to the end if then stops?

had to change

sub PasteData(rng1 as Range)

to

sub PasteData(rng1 as Range, rng2 as Range)

as it said that rng2 was not defined

any ideas

[Bob Phillips]

Oops sorry about that. I originally thought there was only one variable range and created the code as such. Spotted the extra one, changed (most ) of the code, but forgot the procedure signature.

You changed it correctly though.

[northernstar]

yes i did thanks and it seems to be working quite well

thanks again

[unmarkedhelicopter]

northernstar, sorry to be a pain but could you please (in future) title your thread such that peaople searching the database can see what it is about, this helps contributors as a graph expert will look at graphing threads, an array expert will look at complex table calculations etc. It also means that if I (or anyone) has a problem with table generation I would see that this thread may be relevant.