VBA Optimization

markusreyes2907

New Member
Joined
Jul 14, 2020
Messages
32
Office Version
  1. 2013
Platform
  1. Windows
Hi, recently I wrote some code which works perfectly. I've only been doing VBA for about a month, so wondering if anyone out there can take a look at it and let me know if there's a way simpler way to do achieve the same goal. The code I created is only a small part of a whole, so the user would enter a number of experimental days in an InputBox which would I would have those days 1 to whatever the number entered in most of the other sections. However, in this section of my tables I need the numbers by a factor of 7. If the number of experimental days is less than 7 then you would have Day 0 and END. If it's a multiple of it 7 you would have 0, 7, 14...etc without END. If its any other number between the multiples of the 7 (lets say the user entered 25 as number of experimental days) it would look like 0, 7, 14, 21 and END. I hope that makes sense.

Anyway just some curiosity! Below is the code. Thanks!

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

Dim numdays&, i As Integer, j As Integer, k As Integer
numdays = InputBox("Number of days", "Days")
k = (numdays + 7) \ 7
    For j = 0 To 7 Step 7
        For i = 1 To k
            Range("B4").Cells(1, i) = j
    j = j + 7
    Next i
Next j


If numdays = 7 Then
    k = numdays \ 7
    Range("B4").Resize(, k + 1).Borders(3).Weight = xlThin: Range("B4").Resize(, k + 1).Borders(4).Weight = xlThin
ElseIf numdays = (7 * k) - 7 Then
    Range("B4").Resize(, k).Borders(3).Weight = xlThin: Range("B4").Resize(, k).Borders(4).Weight = xlThin
ElseIf numdays < 7 Then
    Range("B4").Resize(, k + 1).Borders(3).Weight = xlThin: Range("B4").Resize(, k + 1).Borders(4).Weight = xlThin
    Range("B4").Offset(, 1) = "END"
Else
    Range("B4").Resize(, k + 1).Borders(3).Weight = xlThin: Range("B4").Resize(, k + 1).Borders(4).Weight = xlThin
    Range("B4").End(xlToRight).Offset(, 1) = "END"
End If
 

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,218
Office Version
  1. 365
Platform
  1. Windows
You don't need both loops and you could use a different method to get the values.
VBA Code:
Dim numdays&, i As Integer, j As Integer, k As Integer
Dim x As Variant

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


    numdays = InputBox("Number of days", "Days")

    k = (numdays + 7) \ 7

    x = Application.Transpose(Evaluate("(ROW(1:" & k & ")-1)*7"))

    If numdays Mod 7 <> 0 Then
        ReDim Preserve x(k)
        x(k) = "END"
    Else
        k = k - 1
    End If
    
    With Range("B4").Resize(, k + 1)
        .Borders(3).Weight = xlThin
        .Borders(4).Weight = xlThin
        .Value = x
    End With
 

markusreyes2907

New Member
Joined
Jul 14, 2020
Messages
32
Office Version
  1. 2013
Platform
  1. Windows
You don't need both loops and you could use a different method to get the values.
VBA Code:
Dim numdays&, i As Integer, j As Integer, k As Integer
Dim x As Variant

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


    numdays = InputBox("Number of days", "Days")

    k = (numdays + 7) \ 7

    x = Application.Transpose(Evaluate("(ROW(1:" & k & ")-1)*7"))

    If numdays Mod 7 <> 0 Then
        ReDim Preserve x(k)
        x(k) = "END"
    Else
        k = k - 1
    End If
   
    With Range("B4").Resize(, k + 1)
        .Borders(3).Weight = xlThin
        .Borders(4).Weight = xlThin
        .Value = x
    End With
Oh great thank you for the repose! I’ve seen Evaluate used in code but haven’t quite gotten a grasp on it. I see how useful it is and now I’ll just do some more studying to figure it out. Really appreciate it!
 

Watch MrExcel Video

Forum statistics

Threads
1,122,495
Messages
5,596,490
Members
414,070
Latest member
DuncanLucas

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