VBA If Then statement to do stuff or end sub - excel

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.

Related

How to write a slicker macro

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.

How to insert numbers into a cell without it changing to date in VBA

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:

VBA - multiply columns

I am running a small VBA to loop through a range of rows (27 - 52) to return a simple multiplication of column D X column E to column F.
My code below crashes Excel. Can anyone point out the obvious as to where i am going wrong. I am clearly no expert!
Private Sub Worksheet_Change(ByVal Target As Range)
For i = 27 To 52
Cells(i, 6) = Cells(i, 4) * Cells(i, 5)
Next i
End Sub
Thanks
Excel will crash as your code is creating an infinite loop, due to Change Event that you are using. Every time your code multiplies two given cells it is being identified as a change event, so your code will be triggered again, and again...
You can either use the adjusted code that Michal has posted, or you can adjust your original code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
For i = 27 To 52
Cells(i, 6) = Cells(i, 4) * Cells(i, 5)
Next i
Application.EnableEvents = True
End Sub
Hope it helps!
I don't see how it would "crash" Excel, abyway you don't need Change(ByVal Target As Range)so it's simply:
Private Sub foo()
For i = 27 To 52
Cells(i, 6).Value = Cells(i, 4).Value * Cells(i, 5).Value
Next i
End Sub

Inserting new row in excel by VBA

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

Find next ocurrence of values - COUNTIF is too slow

I'm trying to speed up a COUNTIFS formula in a table I have.
The table is over 60k rows and the COUNTIFS has three conditions. The formula right now looks like this:
=IF(AND(COUNTIFS([Vessel],[#Vessel],[Date],">"&[#Date],[ETA],"<="&[#ETA]+20)=0,[#Arrived]=1,[#Sailed]=1,[#Date]<MAX([Date])),1,0)
The problem is that the calculation takes a very long time and it triggers everytime something change, even the filter. I don't want to turn calculations to manual in this sheet.
The purpose of the formula is to find the next occurence of the vessel in the line, the ETA can be slightly changed from day to day or the same ship can appear months later. I need to confirm if the vessel appears with the same ETA (or up to 20 days of difference) on another day.
Is there any other solution to this problem?
Maybe try building this as a macro instead, that way you would have control over when it executes.
Here is a start on a method for doing this. It gets the job done but breaks on an error on/after the last line is processed. Edit : Fixed and tested
Public Sub shipcheck()
Application.ScreenUpdating = False
Dim x As Long
Dim y As String
Dim counter As Long
For x = 2 To Range("A85536").End(xlUp).Row ' Assuming data has headers
y = Cells(x, 1) ' This assumes your vessel is in the first column
counter = x + 1
Do
If cells(counter,1) = "" Then Exit Do
If y = Cells(counter, 1) Then
If Cells(x, 2) <> Cells(counter, 2) Then 'This assumes your date is the second column
If DateDiff("d", Cells(x, 3), Cells(counter, 3)) > 20 Then ' this assumes ETA is your third column
Cells(x, 4) = 1 'This assumes the positive test is the fourth column
Cells(counter, 4) = 1
Exit Do
Else
End If
Else
End If
Else
End If
counter = counter + 1
Loop
Next x
Application.ScreenUpdating = True
End Sub

Resources