Help with code & some explanation

markusreyes2907

New Member
Joined
Jul 14, 2020
Messages
32
Office Version
  1. 2013
Platform
  1. Windows
I am trying to create a code that builds tables based on user input from input boxes. I have most of it down, and thanks to asking a question a few days ago, I am well on my way to having my code complete. I am however, having an issue that I would like some help solving. In the attached image you can see after the Temperature table, there is a table for Mean, Std Dev, Min and Max. I need to recreate this table next to all the other tables that I have built into the code. The next table is for Dissolved Oxygen, (labeled DO), and after tables for pH, Hardness, Alkalinity, and Conductivity. I have tired to create code to replicate the "Means" table, but I can't figure out how to get it so position correctly based on the different values given by the user in the beginning. Below is the code I have so far. If you do provide code that would help me solve my issue, I would also appreciate some explanation so that I can understand how to solve an issue like this in the future. Thanks!

VBA Code:
Dim reps As Long, i As Long, trtmnt As Long, j As Long, Rws As Long
On Error Resume Next
reps = InputBox("Number of reps", "Enter Here")
trtmnt = InputBox("Number of total treatment groups", "Enter Here")
Rws = 6

For i = 1 To trtmnt
   Range("A" & Rws).Value = i
   For j = 1 To reps
      Range("B" & Rws) = " "
        Rws = Rws + 1
            Next j
   Rws = Rws + 1
Next i


With Range("B4:C4")
    .Merge
    .Value = "Day of Test"
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
End With

Dim numdays As Integer, k As Integer
numdays = InputBox("Number of study days", "Enter Here")

For k = 0 To numdays
    With Range("C5").Cells(1, k)
    .Value = k
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    End With
Next k

Dim Rws2 As Long
    Rws2 = 5
    Range("A" & 5).Cells.Offset(0, k + 2).Value = "Treatment"
    For i = 1 To trtmnt
    Range("A" & Rws2).Cells.Offset(1, k + 2).Value = i
    Rws2 = Rws2 + 1
    Next i
    Range("A" & 5).Cells.Offset(0, k + 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("A" & 5).Cells.Offset(0, k + 3).Value = "Mean"
    Range("A" & 5).Cells.Offset(0, k + 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("A" & 5).Cells.Offset(0, k + 4).Value = "Std Dev"
    Range("A" & 5).Cells.Offset(0, k + 4).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("A" & 5).Cells.Offset(0, k + 5).Value = "Min"
    Range("A" & 5).Cells.Offset(0, k + 5).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("A" & 5).Cells.Offset(0, k + 6).Value = "Max"
    Range("A" & 5).Cells.Offset(0, k + 6).Borders(xlEdgeBottom).LineStyle = xlContinuous
        
    
Dim Rws3 As Long
  Rws3 = 4
    Range("A" & 5).Cells.Offset(0, k + 8).Value = "Treatment"
    For i = 1 To trtmnt
    Range("A" & Rws3).Cells.Offset(2, k + 8).Value = i
    Rws3 = Rws3 + 1
    For j = 1 To reps
      Range("B" & Rws3) = " "
                 Next j
   Rws3 = Rws3 + 2
    Next i
    Range("A" & 5).Cells.Offset(0, k + 8).Borders(xlEdgeTop).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 8).Borders(xlEdgeBottom).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 9).Value = "Temp"
    Range("A" & 5).Cells.Offset(0, k + 9).Borders(xlEdgeTop).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 9).Borders(xlEdgeBottom).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 10).Value = "DO"
    Range("A" & 5).Cells.Offset(0, k + 10).Borders(xlEdgeTop).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 10).Borders(xlEdgeBottom).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 11).Value = "pH"
    Range("A" & 5).Cells.Offset(0, k + 11).Borders(xlEdgeTop).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 11).Borders(xlEdgeBottom).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 12).Value = "Hardness"
    Range("A" & 5).Cells.Offset(0, k + 12).Borders(xlEdgeTop).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 12).Borders(xlEdgeBottom).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 13).Value = "Alkalinity"
    Range("A" & 5).Cells.Offset(0, k + 13).Borders(xlEdgeTop).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 13).Borders(xlEdgeBottom).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 13).Value = "Conductivity"
    Range("A" & 5).Cells.Offset(0, k + 13).Borders(xlEdgeTop).LineStyle = xlDouble
    Range("A" & 5).Cells.Offset(0, k + 13).Borders(xlEdgeBottom).LineStyle = xlDouble



  Range("A" & Rws).Cells.Offset(2, 0).Value = "DO"
  Range("A" & Rws).Cells.Offset(2, 0).Font.Bold = True
  
  Range("A" & Rws).Cells.Offset(4, 0).Value = "Treatment"
  Range("A" & Rws).Cells.Offset(4, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous
  Range("A" & Rws).Cells.Offset(3, 1).Value = "Day of Test"
For k = 0 To numdays
  With Range("A" & Rws).Cells.Offset(4, k + 1)
  .Value = k
  .Borders(xlEdgeBottom).LineStyle = xlContinuous
  .Borders(xlEdgeTop).LineStyle = xlContinuous
  End With
Next k
For i = 1 To trtmnt
  Range("A" & Rws).Cells.Offset(5, 0).Value = i
  For j = 1 To reps
    Range("B" & Rws).Cells.Offset(5, 0).Value = " "
        Rws = Rws + 1
    Next j
  Rws = Rws + 1
Next i
 
    
Range("A" & Rws).Cells.Offset(7, 0).Value = "pH"
  Range("A" & Rws).Cells.Offset(7, 0).Font.Bold = True
  
  Range("A" & Rws).Cells.Offset(9, 0).Value = "Treatment"
  Range("A" & Rws).Cells.Offset(9, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous
  Range("A" & Rws).Cells.Offset(8, 1).Value = "Day of Test"
  For k = 0 To numdays
  With Range("A" & Rws).Cells.Offset(9, k + 1)
  .Value = k
  .Borders(xlEdgeBottom).LineStyle = xlContinuous
  .Borders(xlEdgeTop).LineStyle = xlContinuous
  End With
Next k
   
For i = 1 To trtmnt
  Range("A" & Rws).Cells.Offset(10, 0).Value = i
  For j = 1 To reps
    Range("B" & Rws).Cells.Offset(10, 0).Value = " "
        Rws = Rws + 1
    Next j
  Rws = Rws + 1
Next i

Range("A" & Rws).Cells.Offset(12, 0).Value = "Hardness"
  Range("A" & Rws).Cells.Offset(12, 0).Font.Bold = True
  
  Range("A" & Rws).Cells.Offset(14, 0).Value = "Treatment"
  Range("A" & Rws).Cells.Offset(13, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous
  Range("A" & Rws).Cells.Offset(13, 1).Value = "Day of Test"
For k = 0 To numdays
  With Range("A" & Rws).Cells.Offset(14, k + 1)
  .Value = k
  .Borders(xlEdgeBottom).LineStyle = xlContinuous
  .Borders(xlEdgeTop).LineStyle = xlContinuous
  End With
Next k
  Range("A" & Rws).Cells.Offset(15, 0).Value = "NC"
  Range("A" & Rws).Cells.Offset(16, 0).Value = "High"
  
Range("A" & Rws).Cells.Offset(19, 0).Value = "Alkalinity"
  Range("A" & Rws).Cells.Offset(19, 0).Font.Bold = True
  
  Range("A" & Rws).Cells.Offset(21, 0).Value = "Treatment"
  Range("A" & Rws).Cells.Offset(20, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous
  Range("A" & Rws).Cells.Offset(20, 1).Value = "Day of Test"
For k = 0 To numdays
  With Range("A" & Rws).Cells.Offset(21, k + 1)
  .Value = k
  .Borders(xlEdgeBottom).LineStyle = xlContinuous
  .Borders(xlEdgeTop).LineStyle = xlContinuous
  End With
Next k
  Range("A" & Rws).Cells.Offset(22, 0).Value = "NC"
  Range("A" & Rws).Cells.Offset(23, 0).Value = "High"
  
Range("A" & Rws).Cells.Offset(26, 0).Value = "Conductivity"
  Range("A" & Rws).Cells.Offset(26, 0).Font.Bold = True
  Range("A" & Rws).Cells.Offset(28, 0).Value = "Treatment"
  Range("A" & Rws).Cells.Offset(27, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous
  Range("A" & Rws).Cells.Offset(27, 1).Value = "Day of Test"
For k = 0 To numdays
  With Range("A" & Rws).Cells.Offset(28, k + 1)
  .Value = k
  .Borders(xlEdgeBottom).LineStyle = xlContinuous
  .Borders(xlEdgeTop).LineStyle = xlContinuous
  End With
Next k
  Range("A" & Rws).Cells.Offset(29, 0).Value = "NC"
  Range("A" & Rws).Cells.Offset(30, 0).Value = "High"
 

Attachments

  • Capture1.PNG
    Capture1.PNG
    37.7 KB · Views: 16

markusreyes2907

New Member
Joined
Jul 14, 2020
Messages
32
Office Version
  1. 2013
Platform
  1. Windows
You are welcome & glad to help

So everything is as expected now ? I made the code to do exactly what you have in your sample file ... To be honest, the summary table was a bit of a headache though but got it right :)
OOpos I never responded! Yes this was great! Thank you :)
 

Some videos you may like

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

mse330

Well-known Member
Joined
Oct 18, 2007
Messages
715
Office Version
  1. 365
Platform
  1. Windows
Excellent :) Thanks for the feedback
 

markusreyes2907

New Member
Joined
Jul 14, 2020
Messages
32
Office Version
  1. 2013
Platform
  1. Windows
Excellent :) Thanks for the feedback
Hi mse330,

I've been studying the code you made so that I can learn how to write better code. I understand nearly all of it but two lines. If your time isn't too preoccupied, I was wondering if you could break down these two lines and help me understand exactly what is going on with them. If you don't have time, no problem I can always post the question on the forum and see what responses I get.


VBA Code:
a = Evaluate(Replace("if({1},if(mod(row(@)," & Reps + 1 & ")-1=0,roundup(row(@)/" & Reps + 1 & ",0),""""))", "@", Cells(1).Resize(Reps * (Trtmnt + 1)).Address))
   Rg.Cells(1).Offset(1, -1).Resize(UBound(a)) = a

Thanks,

markus
 

mse330

Well-known Member
Joined
Oct 18, 2007
Messages
715
Office Version
  1. 365
Platform
  1. Windows
Hi Markus,

Let me try to break it down for you

"a" is an array that I used to temporarily hold the output of the Evaluate statement. Evaluate in VBA returns the formula value & I then I used Replace & used the "@" symbol (which I learned from Rick in this forum) instead of typing Cells(1).Resize(Reps * (Trtmnt + 1)).Address multiple times.

Now to the formula, I used Mod function along with the Row() function number to return an array of required numbers with the blanks between them. To make it easier for you, I've provided the formula in excel breaking it down to each component to see how it's built as shown below to reach my final goal ... Final formula is in column E

Hope that clears it up for you :)

Cell Formulas
RangeFormula
A1:A17A1=MOD(ROW(),$H$1)
B1:B17B1=MOD(ROW(),$H$1+1)-1
C1:C17C1=ROW()/$H$1
D1:D17D1=ROUNDUP(ROW()/($H$1+1),0)
E1:E17E1=IF(MOD(ROW(),$H$1+1)-1=0,ROUNDUP(ROW()/($H$1+1),0),"")
 

markusreyes2907

New Member
Joined
Jul 14, 2020
Messages
32
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Hi Markus,

Let me try to break it down for you

"a" is an array that I used to temporarily hold the output of the Evaluate statement. Evaluate in VBA returns the formula value & I then I used Replace & used the "@" symbol (which I learned from Rick in this forum) instead of typing Cells(1).Resize(Reps * (Trtmnt + 1)).Address multiple times.

Now to the formula, I used Mod function along with the Row() function number to return an array of required numbers with the blanks between them. To make it easier for you, I've provided the formula in excel breaking it down to each component to see how it's built as shown below to reach my final goal ... Final formula is in column E

Hope that clears it up for you :)

Cell Formulas
RangeFormula
A1:A17A1=MOD(ROW(),$H$1)
B1:B17B1=MOD(ROW(),$H$1+1)-1
C1:C17C1=ROW()/$H$1
D1:D17D1=ROUNDUP(ROW()/($H$1+1),0)
E1:E17E1=IF(MOD(ROW(),$H$1+1)-1=0,ROUNDUP(ROW()/($H$1+1),0),"")
Aaah yes seeing that math being done is exactly what I needed! So the “@“ simply means this given row in a way. Thank you so much!
 

markusreyes2907

New Member
Joined
Jul 14, 2020
Messages
32
Office Version
  1. 2013
Platform
  1. Windows
Hi mse,

I want to thank you again with helping me with this complicated code. As it was my first time writing any macro in VBA it was really helpful to see the different ways you made my original code much more efficient, as well as helping figure out how to do some tricky things. I fixed up the code a little bit a now it does exactly what I want (I wasn't super clear before I realize) and now it works like a charm. I mostly had to change the Offset in the summary table formulas and change the size of the summary table. I'll show you my code below if you're curious to take a look and can comment on my changes if you like. I probably did the Offset in a way more complicated way than need. If you don't feel like looking at it, that's also fine! Cheers!

VBA Code:
With Cells
    .Font.Name = "Times New Roman"
    .Font.Size = 10
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

Dim rg As Range, numdays&, reps&, trtmnt As Byte, lr&, x&, rws, FR As Range, Fa$, j&, AA$, BB$, r As Range

reps = InputBox("Number of reps")
trtmnt = InputBox("Number of total treatment groups")
numdays = InputBox("Number of observation days")

For x = 1 To 3

lr = IIf(x = 1, 5, Range("A" & Rows.Count).End(3).Offset(reps + 4).Row)
Set rg = Cells(lr, 2).Resize(, numdays + 1)
rg.Cells(1).Offset(-2, -1).Resize(3) = Application.Transpose(Array(IIf(x = 1, "Temperature", IIf(x = 2, "DO", "pH")), "", "Treatment"))
rg.Cells(1).Offset(-2, -1).Font.Bold = True
rg.Cells(1).Offset(-1) = "Day of Test"
rg.Cells(1).Offset(-1).Resize(, 2).Merge
rg = Evaluate("column(" & rg.Address & ")-2")
rg.Borders(3).Weight = xlThin: rg.Offset(, -1).Resize(, rg.Columns.Count + 1).Borders(4).Weight = xlThin
rws = Evaluate(Replace("if({1},if(mod(row(@)," & reps + 1 & ")-1=0,roundup(row(@)/" & reps + 1 & ",0),""""))", "@", Cells(1).Resize(reps * (trtmnt + 1)).Address))
rg.Cells(1).Offset(1, -1).Resize(UBound(rws)) = rws


Set rg = rg.Cells(1).Offset(, rg.Columns.Count + 1)
rg.Resize(, 5) = Array("Treatment", "Mean", "Std Dev", "Min", "Max")
rg.Resize(, 5).Borders(4).Weight = xlThin
rg.Offset(1).Resize(trtmnt) = Evaluate("row(" & Cells(1).Resize(trtmnt).Address & ")")

For i = 1 To trtmnt
      j = IIf(i = 1, 1, (i - 1) * (reps + 1) + 1)
      Fa = Cells(lr, 2).Resize(, numdays + 1).Resize(reps).Offset(j).Address
      Set FR = rg.Offset(i, 1).Resize(, 4)
      FR = Array("=average(" & Fa & ")", "=stdev(" & Fa & ")", "=min(" & Fa & ")", "=max(" & Fa & ")")
   Next

Dim z
z = 3
If x = 1 Then
    Set rg = rg.Offset(, 6)
    rg.Resize(, 7) = Array("Treatment", "Temperature", "DO", "pH", "Hardness", "Alkalinity", "Conductivity")
    rg.Resize(, 7).Borders(3).LineStyle = xlDouble: rg.Resize(, 7).Borders(4).LineStyle = xlDouble
    rws = Evaluate(Replace("if({1}, if(mod(row(@)," & z & ")-1=0,roundup(row(@)/" & z & ", 0),""""))", "@", Cells(1).Resize(trtmnt * 3).Address))
    rg.Offset(1).Resize(UBound(rws)) = rws
End If


For i = 1 To trtmnt * reps Step reps
      If x > 1 Then If i = 1 Then Set rg = rg.Offset(, 6)
      j = IIf(i = 1, 1, j + 1)
      If x = 1 Then Set r = rg
      AA = rg.Offset(1 + j - 1, -5).Address: BB = rg.Offset(1 + j - 1, -4).Address
      If i = 1 Then r.Offset(i, 1 + x - 1) = "=round(" & AA & ",1)&"" ± ""&round(" & BB & ",2)" Else r.Offset((5 * (j - 1) + 1) - (j + 1) + (z - j), 1 + x - 1) = "=round(" & AA & ",1)&"" ± ""&round(" & BB & ",2)"
      AA = rg.Offset(1 + j - 1, -3).Address: BB = rg.Offset(1 + j - 1, -2).Address
      If i = 1 Then r.Offset(1 + i, 1 + x - 1) = "=" & AA & "& "" – ""&" & BB Else r.Offset((5 * (j - 1) + 1) - j + (z - j), x) = "=" & AA & "& "" – ""&" & BB
   Next
Next

Dim k, mm
mm = (numdays + 7) \ 7
k = Application.Transpose(Evaluate("(ROW(1:" & mm & ")-1)*7"))

If numdays Mod 7 <> 0 Then
 ReDim Preserve k(mm)
 k(mm) = "END"
Else
 mm = mm - 1
End If

For x = 1 To 3
lr = IIf(x = 1, Range("A" & Rows.Count).End(3).Offset(reps + 4).Row, lr + 7)
Set rg = Cells(lr, 2).Resize(, mm + 1)
rg.Borders(3).Weight = xlThin: rg.Offset(, -1).Resize(, mm + 2).Borders(4).Weight = xlThin
rg = k
rg.Cells(1).Offset(-2, -1).Resize(3) = Application.Transpose(Array(IIf(x = 1, "Hardness", IIf(x = 2, "Alkalinity", "Conductivity")), "", "Treatment"))
rg.Cells(1).Offset(-2, -1).Font.Bold = True
rg.Cells(1).Offset(1, -1).Resize(2) = [{"NC";"High"}]
Set rg = rg.Cells(1).Offset(, rg.Columns.Count + 1)
rg.Resize(, 5) = Array("Treatment", "Mean", "Std Dev", "Min", "Max")
rg.Resize(, 5).Borders(4).Weight = xlThin
rg.Offset(1).Resize(2) = [{"NC";"High"}]

For i = 1 To 2
      Fa = Cells(lr, 2).Resize(, mm + 1).Offset(i).Address
      Set FR = rg.Offset(i, 1).Resize(, 4)
      FR = Array("=average(" & Fa & ")", "=stdev(" & Fa & ")", "=min(" & Fa & ")", "=max(" & Fa & ")")
   Next

 For i = 1 To trtmnt * reps Step reps
      j = IIf(i = 1, 1, j + 1)
      If i = 1 Then If x = 1 Then Set r = r.Offset(, 4) Else Set r = r.Offset(, 1)
      If i = 1 Or i = ((trtmnt * reps) - reps + 1) Then
         If i = ((trtmnt * reps) - reps + 1) Then j = 2
         AA = rg.Offset(1 + j - 1, 1).Address: BB = rg.Offset(1 + j - 1, 2).Address
         If j = 1 Then r.Offset(i) = "=round(" & AA & ",1)&"" ± ""&round(" & BB & ",2)" Else r.Offset(trtmnt + trtmnt + (trtmnt - 2)) = "=round(" & AA & ",1)&"" ± ""&round(" & BB & ",2)"
        
         AA = rg.Offset(1 + j - 1, 3).Address: BB = rg.Offset(1 + j - 1, 4).Address
         If j = 1 Then r.Offset(1 + i) = "=" & AA & "& "" – ""&" & BB Else r.Offset((trtmnt + trtmnt + (trtmnt - 2)) + 1) = "=" & AA & "& "" – ""&" & BB
      Else
         r.Offset((5 * (j - 1) + 1) - (j + 1) + (z - j)) = "--":  r.Offset((5 * (j - 1) + 1) - j + (z - j)) = "--"
      End If
   Next
Next
 

mse330

Well-known Member
Joined
Oct 18, 2007
Messages
715
Office Version
  1. 365
Platform
  1. Windows
I didn't go through the code but I'm really happy that you could figure out the code & amend it to suite your needs. Best of luck :)
 

Watch MrExcel Video

Forum statistics

Threads
1,127,650
Messages
5,626,084
Members
416,161
Latest member
David1966Lewis

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
Top