The script is as follows :
Sub Macro1()
Lastrow1 = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count,5).End(xlDown).Row
For y = 2 To Lastrow1
If Cells(y, 6) <> "" Then
Cells(y, 7).Formula = "=Networkdays(E2,F2,$S$2:$S$14)"
Else
Exit For
End If
Next y
End Sub
My problems start with the formula here ; for example, I would like to pick E2,F2 and those constant "$S$2:$S$14" and then loop to E3,F3 and so until until in "F columns" it finds nothing and the loop will end.
Any hint on this one? Probably this has been asked quite a few times but once you start, the problem is not only the lack of knowledge but as well lack of the skill of asking the correct question.
How about:
Sub Macro1()
Lastrow1 = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 5).End(xlDown).Row
For y = 2 To Lastrow1
If Cells(y, 6) <> "" Then
Cells(y, 7).Formula = "=Networkdays(E" & y & ",F" & y & ",$S$2:$S$14)"
Else
Exit For
End If
Next y
End Sub
Maybe something like the below code.
It finds the last row (use xlUp rather than xlDown) and places the formula between row 2 and the last row in column G.
Public Sub InsertFormula()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, 6).End(xlUp).Row
'Put the formula in the range G2:G & LastRow
.Range(.Cells(2, 7), .Cells(LastRow, 7)).Formula = "=Networkdays(E2,F2,$S$2:$S$14)"
End With
End Sub
Related
I need some helps.
So I have 2 commands using VBA in Excel. The first one is removing rows when column G is online and the value in column Q is BBC. Here is the code
Sub RemoveRows()
Dim i As Integer, LastRow As Integer
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
For i = LastRow To 1 Step -1
If ActiveSheet.Cells(i, "G").Value = "Competi" And ActiveSheet.Cells(i, "Q").Value = "BBC" Then
ActiveSheet.Rows(i).Delete
End If
Next i
End Sub
the second command is to rename cell in column H. Here is the code
Sub sentiment()
For Each cell In Range("H" & lastrow & ":H" & clastrow)
Select Case cell.Value
Case "sport"
cell.Value = "(sport)"
Case "politics"
cell.Value = "(politics)"
Case "weather"
cell.Value = "(weather)"
End Select
Next
End Sub
I wonder is there any ways to combine those commands? thank you in advance.
You can call many sub in one command button. Even you can call other sub to inside sub. Just add Call YourOtherSubName before the line End Sub. See below example from your given code.
Sub RemoveRows()
Dim i As Integer, LastRow As Integer
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
For i = LastRow To 1 Step -1
If ActiveSheet.Cells(i, "G").Value = "Competi" And ActiveSheet.Cells(i, "Q").Value = "BBC" Then
ActiveSheet.Rows(i).Delete
End If
Next i
Call sentiment 'Call the other sub.
End Sub
I have a working macro that finds duplicates on a different worksheet and highlights them.
Sub dedup()
Dim i As Long
Dim x As Variant
With Worksheets(1)
For i = 2 To .Cells(.Rows.Count, "C").End(xlUp).Row
x = Application.Match(.Cells(i, "C").Value, Worksheets(2).Columns("C"), 0)
If Not IsError(x) Then
.Cells(i, "C").Interior.ColorIndex = 4
End If
Next i
End With
End Sub
I am trying to now filter the "duplicates" based on a criteria, that is, another column - Column A. The duplicates are to be considered duplicates only if even the Column A values match.
Sub dedup()
Dim i As Long
Dim x As Variant
With Worksheets(1)
For i = 2 To .Cells(.Rows.Count, "C").End(xlUp).Row
x = Application.Match(.Cells(i, "C").Value & .Cells(i, "A").Value, Worksheets(2).Columns("C") & Worksheets(2).Columns("A"), 0)
If Not IsError(x) Then
.Cells(i, "C").Interior.ColorIndex = 4
End If
Next i
End With
End Sub
The logic here, was to concatenate my query and the range I am querying. But, I get a "Type mismatch" error.
Column C is a numeric value, and Column A is a date value
Hi see if following code answers your expectations. I have tweaked it a little bit as per what I could read from your question.
Sub dedup()
Dim i As Long
Dim x, y As Variant
With Worksheets(1)
For i = 2 To .Cells(.Rows.Count, "C").End(xlUp).Row
x = Application.Match(.Cells(i, "A").Value, Worksheets(2).Columns("A"), 0)
y = Application.Match(.Cells(i, "C").Value, Worksheets(2).Columns("C"), 0)
If Not IsError(x) Or IsError(y) Then
.Cells(i, "C").Interior.ColorIndex = 4
End If
Next i
End With
End Sub
You cannot concatenate multicell ranges like Worksheets(2).Columns("C") & Worksheets(2).Columns("A"). Remember this is vba - not python :). You can, however do it within excel as in an array formula so you can use something like
Dim sShtName as String: sShtName = Sheets(2).name
Evaluate("=MATCH(""" & .Cells(i, "C").Value & .Cells(i, "A").Value & """," & sShtName & "!C:C&" & sShtName & "!A:A,0)")
Don't expect this to be fast. You can build a loop to test a match. You can also add a column in Sheets(2) that will hold the concatenated values and Match in this column.
Edit
A much better approach (as suggested by #BigBen) is the use of Application.CountIfs function. The reason it is better (#BigBen can comment on this) is that you do not have to check for errors and all you want is to check whether the value exists or not (i.e. you don't care about where that value is)
*EDIT
Here is what ended up kind of working. The solutions below do not run the AddProj when new row is inserted.
Sub Worksheet_Calculate()
Dim X As Range
Set X = LastCell 'The X is superflous, you could just use the LastCell variable
If Sheet5.Range("A" & Rows.Count).Value < X.Value Then
X.Value = Me.Range("A" & Rows.Count).Value
AddProj
End If
End Sub
Module 1 contains the following:
Function LastCell() As Range
With Sheet5
Set LastCell = .Cells(Rows.Count, 1).End(xlUp)
End With
End Function
Sub AddProj()
Sheet1.Range("Master").Copy Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1)
End Sub
I am trying to read the data in the last cell of a column.
The value of "X" should be the value of this last cell.
I then want "X" to be compared to the number of rows and if the number of rows is less than "X", perform my macro "AddProj".
Once "X" and Column A are the same value, nothing else is to be done.
For some reason, it is not working.
This code is on the worksheet where I want the comparison to be made.
Please see my code below:
Private Sub Worksheet_Calculate()
X = LastCell
If Sheet5.Range("A" & Rows.Count).Value < Sheet5.Range("X").Value Then
Sheet5.Range("X").Value = Me.Range("A" & Rows.Count).Value
AddProj
End If
End Sub
Sub LastCell()
Range("A1").End(xlDown).Select
End Sub
The "AddProj" is a module that is referenced in the code above (thank you #jsheeran #SJR ACyril for help):
Sub AddProj()
Sheet1.Range("Master").Copy Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1)
End Sub
Thanks in advance.
Try this:
Sub Worksheet_Calculate()
Dim lRow As Long
lRow = Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row
If Sheet5.Cells(lRow, 1) > lRow Then
Sheet5.Cells(lRow, 1) = lRow
AddProj
End If
End Sub
X is a variable but you refer to it as "X". Also avoid using .Select as it is not necessary and even in this case just does nothing, because first of all a Sub cannot return a value and second .Select has also no return value. The best way to calculate the last row is this: Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row
Here is just a slight variation on UPGs great answer.
Dim lRow As Long
lRow = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
If lRow >= Sheet1.Cells(lRow, 1) Then
Exit Sub
Else: AddProj
End If
I have put together a Macro that allows me to archive Data from one sheet to another however I am having trouble having it Clear the info afterwards. The first Column contains numbers that I do not want to clear, right now it is only clearing the data in column B.
If someone could take a look at this I would be very greatful.
'Sub archive()
Dim i, lastrow
Dim mytext As String
lastrow = Sheets("Rooms").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastrow
mytext = Sheets("Rooms").Cells(i, "F").Text
If InStr(mytext, "yes") Then
Sheets("Rooms").Cells(i, "A").EntireRow.Copy Destination:=Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)
Sheets("Rooms").Cells(i, "B").Clear
End If
Next i
End Sub'
I've taken the cell on the associated row in column B and extended it to the last cell on the same row containing any value.
Sub archive()
Dim i, lastrow
Dim mytext As String
With WorkSheets("Rooms")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastrow
mytext = .Cells(i, "F").Text
If InStr(1, mytext, "yes", vbTextCompare) Then
.Cells(i, "A").EntireRow.Copy Destination:=Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)
.Range(.Cells(i, "B"), .Cells(i, Columns.Count).End(xlToLeft)).Clear
End If
Next i
End With
End Sub
Additionally, I've used a With ... End With statement to associate WorkSheets("Rooms") with all of its cells to avoid repetitive worksheet referencing.
The Range.Clear command scrubs all values and formatting. If you just want the values to be removed, you may want to switch to Range.ClearContents method.
I have two columns A and B with numbers as values.
In C1 I want =A1 + B1
In C2 I want =A2 + B2
and so on. I have written the following VBA code - while it works it adds "0" after the end of the last row in range.
Let's assume my last row is A10. It adds "0" in C11 when I run the code.
How do I prevent this?
Sub macro()
Dim R As Long
R = 1
Do
Cells(R, "C").Select
R = R + 1
ActiveCell.Formula = "=sum(" & ActiveCell.Offset(0, -2) & "," &
ActiveCell.Offset(0, -1) & ")"
Loop Until IsEmpty(ActiveCell.Offset(0, -2))
End Sub
Just replace your Until condition to the following string:
Loop Until IsEmpty(ActiveCell.Offset(1, -2))
That will check the right cell for being empty. The rest of your code should remain intact.
Take a look at Do Until and Do While and While.
If you really want to iterate over cells you may go ahead. But here a method using Arrays, this will by all means reduces any performance drops that you would get looping over cells...
Option Explicit
Sub AddToRigh()
Dim i As Integer
Dim vArr As Variant
Dim LastRow As Long
'--assume you are working on Sheet 1
LastRow = Sheets(1).Cells(Rows.Count, Range("A1").Column).End(xlUp).Row
ReDim vArr(1 To LastRow)
For i = LBound(vArr) To UBound(vArr)
vArr(i) = "=Sum(RC[-2]:RC[-1])"
Next i
'--output this entire array with formulas into column C
Sheets(1).Range("C1").Resize(UBound(vArr)) = Application.Transpose(vArr)
End Sub
Output:
I'm by no means an expert in vba, but you could do this:
Sub macro()
Dim R As Long
R = 1
Do While Not IsEmpty(ActiveCell.Offset(0, -2))
Cells(R, "C").Select
R = R + 1
ActiveCell.Formula = "=sum(" & ActiveCell.Offset(0, -2) & "," &
ActiveCell.Offset(0, -1) & ")"
Loop
End Sub
I thought I'd recommend a slightly different course of action, just to give you ideas :):
Sub macro()
Dim found As Range
Set found = Range("A:A").Find("*", after:=Range("A1"), searchdirection:=xlPrevious)
If Not found Is Nothing Then
Range(Range("A1"), found).Offset(0, 2).FormulaR1C1 = "=RC[-2]+RC[-1]"
End If
End Sub