I've put together a macro that is meant to increase dates by one in an array of 7 cells ("B2:H2"), (reflecting 7d in a week) once B2 value is changed.
I am sure there is a better way of writing this:
Sub Date_Increment
' increases consecutive days by 1
Range("c2").Value = Range("b2").Value + 1
Range("d2").Value = Range("c2").Value + 1
Range("e2").Value = Range("d2").Value + 1
Range("f2").Value = Range("e2").Value + 1
Range("g2").Value = Range("f2").Value + 1
Range("h2").Value = Range("g2").Value + 1
End Sub
This feels a bit too Neanderthal.
Much appreciate any help.
Use loop. Try-
Sub Date_Increment()
Dim i As Integer
For i = 1 To 7
Cells(2, 2 + i) = Cells(2, 2).Value + i
Next i
End Sub
You can try this:
Sub Date_Increment
' increases consecutive days by 1
Dim i as Long
For i=1 to 6
Range("c2").Cells(i,1).Value = Range("b2").Cells(i,1).Value + 1
Next i
End Sub
Note: Range("c2") implies ActiveSheet.Range("c2") so unless this is code under a specific worksheet you need to be aware that it will only work if the sheet holding the dates is the active sheet.
See if below code is useful for you.
Sub Date_Increment2()
With Range("C2:H2")
.Formula = "=B2+1"
.Value = .Value
End With
End Sub
Personally, I'd leave cell C2 onwards as formula cells as then any change in B2 would get reflected immediately.
Related
I am trying to insert a value into my excel sheet and it keeps changing the string into a date. For example, I am trying to past 2-4 (One of the names for one Unit we use) and instead, I get February 4, 2020. Is there a way to prevent it from being changed?
x = 5
For i = 1 To TheEnd - 1
If IsEmpty(LANL(i, 1)) Then
If Percent(i, 1) = 1 Then
Cells(x, 1) = SU(i, 1)
x = x + 1
End If
End If
Next i
If we do something like:
Sub qwerty()
With ActiveCell
.Clear
.NumberFormat = "#"
.Value = "2-4"
.ClearFormats
End With
End Sub
Our result would be:
I ran into a problem when I try to add the first 10 even numbers in a column regardless of the number of inputs someone has entered into said column.
The issue occurs when there are less than 10 inputs (in my case 7) and I have tried to break the loop if there are no more numbers after the last one but it doesn't seem to work as it crashes Excel; most probably because it loops infinitely.
The original code was fine until I entered below 10 even numbers. When I did it would loop infinitely and crash so I inputted a forceful break in the code (hence the Count=999) but it does not seem to work
Sub TenPosInt()
Dim Total As Integer, size As Integer, myRange As range
Dim Count As Integer
Count = 1
Set myRange = range("W:W")
size = WorksheetFunction.CountA(myRange)
While Count <= 10
If IsEmpty(Cells(Count, "W")) Then
Count = 999
End If
If Cells(Count, "W").Value Mod 2 = 0 Then
Total = Total + Cells(Count, "W").Value
Count = Count + 1
End If
Wend
MsgBox Total
End Sub
My Inputs are currently 2,4,6,5,2,4,6,8,1,3,5 so it does not meet the 10 even integers, however I still want it to run regardless (hence the Count=999 line). The correct return should be 32.
A Do-While/Until loop is recommended instead of While-Wend (see this).*
Here I use a separate counter for row and the number of even values (and stole David's idea of combining the two conditions in the Do line).
Sub TenPosInt()
Dim Total As Long, r As Long, Count As Long
r = 1
Do Until Count = 10 Or Cells(r, "W") = vbNullString
If Cells(r, "W").Value Mod 2 = 0 Then
Total = Total + Cells(r, "W").Value
Count = Count + 1
End If
r = r + 1
Loop
MsgBox Total & " (" & Count & " even numbers)"
End Sub
*Actually I would be more inclined to use one of the other gent's answers, but I have tried to stick as close to yours as possible. (Also a good idea to check a cell is numeric before checking for even-ness.)
Just for fun - here is an approach that uses a For...Next loop, allows for non-numeric entries in Column W, and handles the possibility of blank rows between entries.
Sub TenPosInt()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "W").End(xlUp).Row
Dim i As Long
For i = 1 To lastRow
If Not IsEmpty(Cells(i, "W")) Then
If IsNumeric(Cells(i, "W")) Then
If Cells(i, "W").Value Mod 2 = 0 Then
Dim counter As Long
counter = counter + 1
Dim total As Long
total = total + Cells(i, "W").Value
If counter = 10 Then Exit For
End If
End If
End If
Next
MsgBox total
End Sub
Why not use a standard for loop across a range? this would give more specific inputs for the subroutine.
Description of what is occuring below has been commented out to allow for copy/pasting more easily.
'Define your range (you use columns("W"), but narrow that)... assuming you start in row 2 (assumes row 1 is headers), move to the last row, of the same columns:
lr = cells(rows.count,"W").end(xlup).row
'so you know the last row, loop through the rows:
for i = 2 to lr
'Now you will be doing your assessment for each cell in column "W"
if isnumeric(cells(i,"W").value) AND cells(i,"W").value mod 2 = 0 then
s = s + cells(i,"W").value
counter = counter + 1
if counter = 10 then exit for
end if
'Do that for each i, so close the loop
next i
'You now have determined a total of 10 items in the range and have added your items. Print it:
debug.print s
Edit1: got a comment to not break-up the code in an explanatory fashion, so I have added ' to comment out my explanations in an effort to make my coding portion copy/pasteable as a lump.
I have trouble doing a simple code. I want to add If Then statement, if the condition is met (a cell value is not 1 or 7), then do a block of codes, otherwise end the sub. The block of codes include login to a website and 2 For Next loops. Basically the macro is to run during weekdays and not run if it's Saturday or Sunday. Appreciate your help.
Here's a test code:
Sub test()
Dim i As Integer
'If cell E1 has a value of neither 1 or 7, Do stuff, otherwise End the Sub
If Cells(5, 1) <> 1 Or Cells(5, 1) <> 7 Then
'Do stuff includes login and perform 2 For Next loops in my real code
For i = 1 To 3
Cells(i, 1).Value = Cells(i, 1).Value * 2
Next
End If
End Sub
Try
Sub test()
Dim i As Integer
'If cell E1 has a value of neither 1 or 7, Do stuff, otherwise End the Sub
If Cells(5, 1) = 1 Or Cells(5, 1) = 7 Then
Else
'Do stuff includes login and perform 2 For Next loops in my real code
For i = 1 To 3
Cells(i, 1).Value = Cells(i, 1).Value * 2
Next
End If
End Sub
I finally able to do achieve what I want. I created a new sub that check the day of the week and if it's Saturday or Sunday Then Exit Sub, Else call the original sub that I have and it works great. However as Comintern suggested, I will look into the VBA function of checking date instead of using the spreadsheet. Thanks to all.
I have an excel spreadsheet. In a column of the spreadsheet I have a list of codes (numbers).These codes (numbers) are sorted from highest to lowest values.(some of these codes has been repeated. For example I have three consecutive line with code 1001200).I want to insert new rows between each codes (in case of having repeated codes i just need one new row (for example i Just need one new row for 1001200 not 3 rows) .
I have written the following code but it does not work.
Sub addspace()
Dim space_1(5000), Space_2(5000)
For n = 1 To 5000
Debug.Print space_1(n) = Worksheets("sheet3").Cells(1 + n, 1).Value
Debug.Print Space_2(n) = Worksheets("sheet3").Cells(2 + n, 1).Value
Next
For n = 1 To 5000
If space_1(n) <> Space_2(n) Then
Range("space_1(n)").EntireRow.Insert
End If
Next
End Sub
How can I fix it? (From the code you can see that I am so beginner :)))
Cheers
To insert one empty row between each unique value try this:
Option Explicit
Public Sub addspace()
Dim i As Long
Application.ScreenUpdating = False
With Worksheets("sheet3")
For i = 5000 To 2 Step -1
While .Range("A" & i - 1) = .Range("A" & i)
i = i - 1
Wend
.Rows(i).Insert Shift:=xlDown
Next
End With
Application.ScreenUpdating = True
End Sub
It starts from the end row and moves up, skipping duplicates
The Range("space_1(n)") is invalid. Arg of range object should be a column name like "A1", you can use Range("A" & n).EntireRow.Insert in your code. But I recommend my code.
Please try,
Sub addspace()
Dim n As Integer
For n = 1 To 5000
If Worksheets("sheet3").Cells(n, 1).Value <> Worksheets("sheet3").Cells(n + 1, 1).Value Then
Worksheets("sheet3").Cells(n + 1, 1).EntireRow.Insert
n = n + 1
End If
Next
End Sub
I need to Loop the formula below until Column "B" which contains dates is empty.
I am stuck and I just can't seem to write the VBA Code to do the Loop until there is no more Dates in Column "B". The formula is smoothing out the yields by using those dates that have a yield.
I hope anyone would be able to help me. Thanks in advance
A B C D
5 Factor Date Yield Input
6 3 May-10 .25
7 1 Jun-10
8 2 Jul-10
9 3 Aug-10 0.2000
10 1 Sep-10
11 2 Oct-10
12 3 Nov-10 0.2418
13 1 Dec-10
14 2 Jan-11
15 3 Feb-11 0.3156
16 1 Mar-11
17 2 Apr-11
Sub IsNumeric()
' IF(ISNUMBER(C6),C6,
If Application.IsNumber(range("c6").Value) Then
range("d6").Value = range("c6")
' IF(C6<C5,((OFFSET(C6,2,0)-OFFSET(C6,-1,0))*A6/3+OFFSET(C6,-1,0)),
If range("c6").Select < range("c5").Select Then
range("d6").Value = range("c6").Offset(2, 0).Select - range("c6").Offset(-1, 0).Select * (range("a6").Select / 3) + range("c6").Offset(-1, 0).Select
' IF(C6<>C7,((OFFSET(C6,1,0)-OFFSET(C6,-2,0))*(A6/3)+OFFSET(C6,-2,0)),"")))
If range("c6").Select <> range("c7").Select Then
range("d6").Value = (range("c6").Offset(1, 0).Select) - range("c6").Offset(-2, 0).Select * (range("a6").Select / 3) + range("c6").Offset(-2, 0).Select
Else
range("d6").Value = ""
End If
End If
End If
End Sub
Sub Test01()
Dim m, r, cell As Object
Dim n As Boolean
Set m = Sheets("Sheet1").Cells(1, 2)
Do
Set m = m.Offset(1, 0)
Set r = m.Resize(20, 1)
n = False
For Each cell In r
If cell.Formula <> "" Then
n = True
End If
Next cell
MsgBox m.Formula
Loop Until n = False
End Sub
This will start at B1 and loop all the way down Column B until the loop encounters a cell at which, beneath it, are 20 contiguous blank cells. When the loop arrives at that cell that has 20 consecutive blanks cells beneath it, it will just Offset to the first of those blank cells beneath it and stop.
If I understand it correctly...
You'll need to convert hard coded ranges to variables
You are using offset correctly
I know while/wend is outdated, sorry :)
Sub IsNumeric()
dim tc as range
set tc = range("B6") 'this is always column B, but the row keeps changing in the loop
'IF(ISNUMBER(C6),C6,
while tc <> ""
If Application.IsNumber(tc.offset(0,1).Value) Then
tc.offset(0,2).Value = tc.offset(0,1)
'IF(C6<C5,((OFFSET(C6,2,0)-OFFSET(C6,-1,0))*A6/3+OFFSET(C6,-1,0)),
If tc.offset(0,1) < tc.offset(-1,1) Then
tc.offset(0,2).Value = tc.Offset(2, 1) - tc.Offset(-1, 1) * (tc.offset(0,-1) / 3) + tc.Offset(-1, 1)
'IF(C6<>C7,((OFFSET(C6,1,0)-OFFSET(C6,-2,0))*(A6/3)+OFFSET(C6,-2,0)),"")))
If tc.offset(0,1) <> tc.offset(1,1) Then
tc.offset(0,2) = tc.offset(1,1) - tc.offset(-2,1) * (tc.offset(0,-1) / 3) + tc.offset(-2,1)
Else
tc.offset(0,2) = ""
End If
End If
End If
set tc=tc.offset(1,0)
wend
End Sub