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
Related
I am trying to match a value from a cell (grid_2.range "A1") and grid_2.range("B1") with a column P on a sheet named grid_2 ("Grid2") to copy all the row where there value is located. Therefore, I will need to check on my data and copy/paste the entire row to another sheet maned grid. But for some reason my code loops but only find the match and copy and paste once.
Sub new_copyPaste()
Dim targetSh As Worksheet
Dim i As Variant
Dim lastRow As Long
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
Position = WorksheetFunction.Match(grid_2.Range("A1"), Worksheets("Grid2").Columns(16), 0)
If grid_2.Cells(i, 16).Value = grid_2.Range("A1") Then
Worksheets("Grid2").Rows(Position).Copy
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
Position = WorksheetFunction.Match(grid_2.Range("B1"), Worksheets("Grid2").Columns(16), 0)
If grid_2.Cells(i, 16).Value = grid_2.Range("B1") Then
Worksheets("Grid2").Rows(Position).Copy
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
End Sub
Maybe do you know what I am doing wrong?
I thought about using VLookup, but after researching, it seems that function match would be more appropriate.
I am open for suggestions :)
Match only returns the first match and is not needed here:
Sub new_copyPaste()
Dim lastRow As Long
Dim i As Long
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
If grid_2.Cells(i, 16).Value = grid_2.Range("A1") Then
Worksheets("Grid2").Rows(i).Copy
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
If grid_2.Cells(i, 16).Value = grid_2.Range("B1") Then
Worksheets("Grid2").Rows(i).Copy
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
End Sub
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
*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 a column of data in excel. I want to loop through the data and combine the contents into a single string. I can specify the cell range, but what if the range is unknown. I want to be able to loop until the cell becomes empty. here is what I have so far.
Sub ConcatenationLoop()
Dim rng As Range, i As Integer
Set rng = Range("A1", "A5")
For i = 1 To rng.Rows.Count
With Range("B1")
If .Value = "" Then
.Value = rng.Range("A" & i)
Else
.Value = .Value & ", " & rng.Range("A" & i)
End If
End With
Next
is it possible to combine with something like:
Do Until IsEmpty(ActiveCell)
Much help is appreciated!
End Sub
With Worksheets("YourSheetName")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Loop it to LastRow.
Get the first empty cell from the top using
lLastRow = sheet.Cells(1, 2).End(xlDown).Row
The use this in your for loop
For i = 1 To lLastRow
You could use the following skeleton:
Sub ALoop()
Dim r As Long
r = 2 '//Start row
While Len(Cells(r, "A")) > 0 '//Or While Not IsEmpty(...)
'// Your code
r = r + 1 '//Don't forget to increment row
Wend
End Sub