markusreyes2907
New Member
- Joined
- Jul 14, 2020
- Messages
- 34
- Office Version
- 2013
- Platform
- Windows
I was recently on here and had some great help building tables that I wanted to build. They worked great, but I want to replicate the results with my own skills (novice) so that I understand VBA coding better. Currently I have a code that is doing mostly what I'd like, except once the the user enters 6 or more for the "trtmnt" InputBox the code no longer does what it did for the numbers before. It doesn't work in the "summary table" which is the last part in the code I'm sharing. To be clear, what I want to happen is for underneath "Treatment" I want the number of treatments separated by 2 rows each. If you run the code and enter numbers less than 6 you'll see what I would like to happen no matter the input. I'm wondering if someone can look at my code (again novice so it's definitely more than need be) and tell me why its failing after the number 6 is entered in the InputBox for total number of treatments. If you copy and paste the code you'll see that it works until 6 for some reason. I know there is much to improve, so any explanation for how and why would be appreciated. Below is my code. Thanks!
VBA Code:
ActiveSheet.Name = "Water Chem Means"
Dim StartSheet As Worksheet
Set StartSheet = ActiveSheet
With Cells
.Font.Name = "Times New Roman"
.Font.Size = 10
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
[A1].Value = "???A-???"
Dim reps&, numdays&, trtmnt As Byte
On Error Resume Next
reps = InputBox("Number of reps", "Enter Here")
trtmnt = InputBox("Number of total treatment groups", "Enter Here")
numdays = InputBox("Number of experimental days", "Enter Here")
With Range("A3:B3")
.Merge
.Value = "Temperature"
.Font.Bold = True
.HorizontalAlignment = xlLeft
End With
With Range("A5")
.Value = "Treatment"
.Borders(4).LineStyle = xlContinuous
End With
Range("B4:C4").Merge
Range("B4").Value = "Day of Test"
Dim k As Integer
For k = 0 To numdays
With Range("C5").Cells(1, k)
.Value = k
.Borders(3).LineStyle = xlContinuous
.Borders(4).LineStyle = xlContinuous
End With
Next k
Dim m As Integer, n As Integer, rws As Long
rws = 6
For m = 1 To trtmnt
Range("A" & rws).Value = m
For n = 1 To reps
Range("B" & rws) = ""
rws = rws + 1
Next n
rws = rws + 1
Next m
Dim array1 As Variant
array1 = Array("Treatment", "Mean", "Std Dev", "Min", "Max")
Range("A5").End(2).Cells.Offset(0, 2).Resize(, 5) = array1
Range("A5").End(2).Cells.Offset(0, 2).Resize(, 5).Borders(4).LineStyle = xlContinuous
Dim trtmntrng1
Set trtmntrng1 = Range("A5").End(2).Cells.Offset(1, 2).Resize(trtmnt)
For m = 1 To trtmnt
trtmntrng1.Cells(m, 1).Value = m
Next m
Dim rng1 As Range
Set rng1 = Range("A" & rws).CurrentRegion.Offset(1, 0)
With rng1
.Value = "DO"
.Font.Bold = True
.HorizontalAlignment = xlLeft
End With
rng1.Cells(3, 1).Value = "Treatment"
rng1.Cells(3, 1).Borders(4).LineStyle = xlContinuous
rng1.Cells(2, 2).Value = "Day of Test"
rng1.Cells(2, 2).Resize(1, 2).Merge
For k = 0 To numdays
With rng1.Offset(2, 2).Cells(1, k)
.Value = k
.Borders(3).LineStyle = xlContinuous
.Borders(4).LineStyle = xlContinuous
End With
Next k
For m = 1 To trtmnt
Range("A" & rws + 4).Value = m
For n = 1 To reps
Range("B" & rws + 4) = ""
rws = rws + 1
Next n
rws = rws + 1
Next m
rng1.Cells(3, 1).End(2).Cells.Offset(0, 2).Resize(, 5) = array1
rng1.Cells(3, 1).End(2).Cells.Offset(0, 2).Resize(, 5).Borders(4).LineStyle = xlContinuous
Dim trtmntrng2
Set trtmntrng2 = rng1.Cells(3, 1).End(2).Cells.Offset(1, 2).Resize(trtmnt)
For m = 1 To trtmnt
trtmntrng2.Cells(m, 1).Value = m
Next m
Dim rng2 As Range
Set rng2 = Range("A" & rws + 4).CurrentRegion.Offset(1, 0)
With rng2
.Value = "pH"
.Font.Bold = True
.HorizontalAlignment = xlLeft
End With
rng2.Cells(3, 1).Value = "Treatment"
rng2.Cells(3, 1).Borders(4).LineStyle = xlContinuous
rng2.Cells(2, 2).Value = "Day of Test"
rng2.Cells(2, 2).Resize(1, 2).Merge
For k = 0 To numdays
With rng2.Offset(2, 2).Cells(1, k)
.Value = k
.Borders(3).LineStyle = xlContinuous
.Borders(4).LineStyle = xlContinuous
End With
Next k
For m = 1 To trtmnt
Range("A" & rws + 8).Value = m
For n = 1 To reps
Range("B" & rws + 8) = ""
rws = rws + 1
Next n
rws = rws + 1
Next m
rng2.Cells(3, 1).End(2).Cells.Offset(0, 2).Resize(, 5) = array1
rng2.Cells(3, 1).End(2).Cells.Offset(0, 2).Resize(, 5).Borders(4).LineStyle = xlContinuous
Dim trtmntrng3
Set trtmntrng3 = rng2.Cells(3, 1).End(2).Cells.Offset(1, 2).Resize(trtmnt)
For m = 1 To trtmnt
trtmntrng3.Cells(m, 1).Value = m
Next m
Dim rng3 As Range
Set rng3 = Range("A" & rws + 8).CurrentRegion.Offset(1, 0)
With rng3
.Value = "Hardness"
.Font.Bold = True
.HorizontalAlignment = xlLeft
End With
rng3.Cells(3, 1).Value = "Treatment"
rng3.Cells(3, 1).Borders(4).LineStyle = xlContinuous
rng3.Cells(4, 1).Value = "NC"
rng3.Cells(5, 1).Value = "L" & trtmnt
rng3.Cells(2, 2).Value = "Day of Test"
rng3.Cells(2, 2).Resize(1, 2).Merge
'For k = 0 To numdays
'With rng3.Offset(2, 2).Cells(1, k)
' .Value = k
' .Borders(3).LineStyle = xlContinuous
' .Borders(4).LineStyle = xlContinuous
'End With
'Next k
rng3.Cells(3, 1).End(2).Cells.Offset(0, 2).Resize(, 5) = array1
rng3.Cells(3, 1).End(2).Cells.Offset(0, 2).Resize(, 5).Borders(4).LineStyle = xlContinuous
Dim rng4 As Range
Set rng4 = Range("A" & rws + 16)
With rng4
.Value = "Alkalinity"
.Font.Bold = True
.HorizontalAlignment = xlLeft
End With
rng4.Cells(3, 1).Value = "Treatment"
rng4.Cells(3, 1).Borders(4).LineStyle = xlContinuous
rng4.Cells(4, 1).Value = "NC"
rng4.Cells(5, 1).Value = "L" & trtmnt
rng4.Cells(2, 2).Value = "Day of Test"
rng4.Cells(2, 2).Resize(1, 2).Merge
rng4.Cells(3, 1).End(2).Cells.Offset(0, 2).Resize(, 5) = array1
rng4.Cells(3, 1).End(2).Cells.Offset(0, 2).Resize(, 5).Borders(4).LineStyle = xlContinuous
Dim rng5 As Range
Set rng5 = Range("A" & rws + 23)
With rng5
.Value = "Conductivity"
.Font.Bold = True
.HorizontalAlignment = xlLeft
End With
rng5.Cells(3, 1).Value = "Treatment"
rng5.Cells(3, 1).Borders(4).LineStyle = xlContinuous
rng5.Cells(4, 1).Value = "NC"
rng5.Cells(5, 1).Value = "L" & trtmnt
rng5.Cells(2, 2).Value = "Day of Test"
rng5.Cells(2, 2).Resize(1, 2).Merge
rng5.Cells(3, 1).End(2).Cells.Offset(0, 2).Resize(, 5) = array1
rng5.Cells(3, 1).End(2).Cells.Offset(0, 2).Resize(, 5).Borders(4).LineStyle = xlContinuous
Range("B5").End(2).Cells.Offset(0, 8).Resize(, 7) = Array("Treatment", "Temp", "DO", "pH", "Hardness", "Alkalinity", "Conductivity")
Range("B5").End(2).Cells.Offset(0, 8).Resize(, 7).Borders(3).LineStyle = xlDouble: Range("A5").End(xlToRight).Cells.Offset(0, 8).Resize(, 7).Borders(4).LineStyle = xlDouble
Dim sumrng1 As Range, spce As Integer, z As Integer, p As Integer
p = -trtmnt + 1
Set sumrng1 = Range("A5").End(2).Cells.Offset(p, 8)
z = m
For m = 1 To trtmnt
sumrng1.Cells(z, 1) = m
For spce = 1 To 2
sumrng1(1, 2).Cells(z, 1) = ""
z = z + 1
Next spce
z = z + 1
Next m