Why is my code failing after a certain input?

markusreyes2907

New Member
Joined
Jul 14, 2020
Messages
34
Office Version
  1. 2013
Platform
  1. 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
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
The first thing to do is remove this line On Error Resume Next, you should never put that at the start of the code & leave it.
All it does is obscures any errors, so you have no idea what is going wrong, where or why.
Once you have removed it, run the code again.
 
Upvote 0
The first thing to do is remove this line On Error Resume Next, you should never put that at the start of the code & leave it.
All it does is obscures any errors, so you have no idea what is going wrong, where or why.
Once you have removed it, run the code again.
Thanks, I removed it and I'm debugging now. Hopefully I can figure it out, if not I may have another question.
 
Upvote 0
Ok, good luck. ?
Ok so I see where it wants to debug, and I'm not sure why. I fixed the first debug, but I still don't get why it's stopping here. Essentially the code still breaks with the input of number 6 for number of treatment groups, "trtmnt." What am I missing?
 

Attachments

  • mrexcelboard.PNG
    mrexcelboard.PNG
    112 KB · Views: 6
Upvote 0
If trtmnt is 6 then from this line
VBA Code:
p = -trtmnt + 1
p=-5
then on the next line you offset the number of rows by p so effectively you have
VBA Code:
Set sumrng1 = Range("A5").End(2).Cells.Offset(-5, 8)
The problem is that as you are on row 5 & can therefore only offset -4 rows, otherwise you go off the sheet.
 
Upvote 0
If trtmnt is 6 then from this line
VBA Code:
p = -trtmnt + 1
p=-5
then on the next line you offset the number of rows by p so effectively you have
VBA Code:
Set sumrng1 = Range("A5").End(2).Cells.Offset(-5, 8)
The problem is that as you are on row 5 & can therefore only offset -4 rows, otherwise you go off the sheet.
Oh ok I see now so I need to set it in reference to a number what won't effect my Offset. Thanks!
 
Upvote 0

Forum statistics

Threads
1,214,911
Messages
6,122,198
Members
449,072
Latest member
DW Draft

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top