View Full Version : Another one for the Experts
northernstar
10-03-2007, 10:07 AM
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
10-03-2007, 10:16 AM
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
10-03-2007, 10:19 AM
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
10-03-2007, 11:38 AM
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
10-03-2007, 10:39 PM
thanks i will do that
thanks again
northernstar
10-03-2007, 11:16 PM
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
10-04-2007, 12:50 AM
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
10-04-2007, 01:16 PM
yes i did thanks and it seems to be working quite well
thanks again
unmarkedhelicopter
10-05-2007, 06:54 AM
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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.