I want this script to check the cells on column A if there is a URL-link in them, and if it is true then perform some cut-paste operations.
String #5 returns error 404, please help to solve this!
Sub xxxxxx()
Worksheets("1 (2)").Activate
For i = 1 To 2200
Range("A" & i).Select
If (cell.Range("A1").Hyperlinks.Count >= 1) Then
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-1, 2).Range("A1").Select
ActiveSheet.Paste
End If
Next i
End Sub
Per #Siddharth Rout post about not using Activate/Select, I've rewritten your code below. No need to check hyperlinks inside the loop every time since it's always checking cell A1
Sub xxxxxx()
Dim ws As Worksheet
Set ws = Worksheets("1 (2)")
Dim LastRow As Long
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
If (ws.Range("A1").Hyperlinks.Count > 0) Then
For i = 2 To LastRow
Range("A" & i).Offset(-1, 2).Value = Range("A" & i).Value
Range("A" & i).Clear
Next i
End If
End Sub
Related
I am trying to search for text on a sheet in column c then if found within the same row select column a and copy and paste to sheet two. i have started with this code
Sub Test()
For Each Cell In Sheets("Asset Capture").Range("C35:C3000")
If Cell.Value = "MONITOR" Then
matchRow = Cell.Row
Rows.Range(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("GRN Status Report").Select
lastRow = ActiveSheet.UsedRange.Rows.Count
If lastRow > 1 Then lastRow = lastRow + 1
ActiveSheet.Range("A" & lastRow).Select
ActiveSheet.Paste
Sheets("Asset Capture").Select
End If
Next
End Sub
but it is selecting the whole row and i can not figure out how to change the code to select data from just the A column?
Try this:
Sub Test()
Dim Cell As Range, rngDest As Range
Set rngDest = Sheets("Grn Status Report").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
For Each Cell In Sheets("Asset Capture").Range("C35:C3000")
If Cell.Value = "MONITOR" Then
Cell.EntireRow.Cells(1).Copy rngDest
Set rngDest = rngDest.Offset(1, 0)
End If
Next
End Sub
Note you don't need to use Select/Activate, and your code will be more robust if you avoid it as much as possible.
See: How to avoid using Select in Excel VBA macros
Hope you looking for this
Sub Test()
increment = Worksheets("GRN Status Report").Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Sheets("Asset Capture").Range("C5:C3000")
If cell.Value = "MONITOR" Then
matchrow = cell.Row
matchcontent = Range("A" & matchrow).Value
Worksheets("GRN Status Report").Cells(increment, 1) = matchcontent
increment = increment + 1
End If
Next
End Sub
I am new to VBA and found what I thought was the answer to my question but is not working. If on my Sheet1 column F contains the value "A - 6:30PM" then I would like the entire row to be copied to a second sheet.
This was the code I was previously using. What is going wrong?
Sub Test()
For Each Cell In Sheets(1).Range("F:F")
If Cell.Value = "A - 6:30PM" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("A").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("A").Select
End If
Next
End Sub
Try changing Sheets("A").Select with Sheets(1).Select at the very end of your code.
This is a cleaner way to do it.
Dim ws As Excel.Worksheet
Set ws = Application.ActiveSheet
Dim lRow as Long
'Starting at row 1 loop through each row of the used range.
lRow = 1
Do While lRow <= ws.UsedRange.Rows.Count
If ws.Range("F" & lRow).Value = "A - 6:30PM" then
Rows(lRow & ":" & lRow).Select
Selection.Copy
Sheets("A").Select
ActiveSheet.Rows(lRow).Select
ActiveSheet.Paste
Sheets("A").Select
End If
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
I'm not sure how your paste code knows what row to paste each row to. But if you need to keep track of a row to paste to just add another counter for the second sheet.
Dim ws As Excel.Worksheet
Set ws = Application.ActiveSheet
'Starting at row 1 loop through each row of the used range.
Dim lRow as Long
Dim lTargetRow as Long
lTargetRow = 1
lRow = 1
Do While lRow <= ws.UsedRange.Rows.Count
If ws.Range("F" & lRow).Value = "A - 6:30PM" then
Rows(lRow & ":" & lRow).Select
Selection.Copy
Sheets("A").Select
ActiveSheet.Rows(lRow).Select
ActiveSheet.Paste
Sheets("A").Select
lTargetRow = lTargetRow + 1
End If
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
I have mathematical equation which I am performing in sheet "Accrued Expenses" on Range("E7"). The formula is intend to loop till the lastrow in column C The two key sheets are "Start page" and "Accrued Expenses" .
The problem is that I am not able to get into VBA code. It works using the Excel macro recorder, but it wont be efficient for maintenance. My equation and code below.
=('Accrued Expenses'!C7*'Start page'!$F$5)/'Start page'!$F$13*'Accrued Expenses'!D7
In Excel recorder code and with a loop:
Option Explicit
Sub Calculating_Accruedexpense()
Sheets("Accrued Expenses").Select
Dim LastRow As Long
LastRow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).row
Range("E7").Select
Do Until ActiveCell.row = LastRow + 1
If IsEmpty(ActiveCell) Then
ActiveCell.FormulaR1C1 = _
"=('Accrued Expenses'!RC[-2]*'Start page'!R5C6)/'Start page'!R13C6*'Accrued Expenses'!RC[-1]"
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Excel Recorder line:
ActiveCell.FormulaR1C1 = _
"=('Accrued Expenses'!RC[-2]*'Start page'!R5C6)/'Start page'!R13C6*'Accrued Expenses'!RC[-1]"
Try this:
Sub Calculating_AccruedExpense()
Dim lastRow As Long, cl As Range
lastRow = Worksheets("Accrued Expenses").Range("C" & Rows.Count).End(xlUp).Row
For Each cl In Range("E7:E" & lastRow)
If IsEmpty(cl) Then
cl = (cl.Offset(0, -1) * Worksheets("Start page").Range("F5")) / Worksheets("Start page").Range("F13") * cl.Offset(0, -2)
End If
Next cl
End Sub
I am running into issues with the Paste Special part of the following code
Sub Copy_Filter1()
Sheets("MASTER PLACEMENT").Select
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("MASTER PLACEMENT").Range("A1").CurrentRegion.AutoFilter
Selection.AutoFilter Field:=52, Criteria1:=">=104"
Columns("AG:AS").EntireColumn.Hidden = True
Rows("1:1").EntireRow.Hidden = True
If (Range("A" & Rows.Count).End(xlUp).Row <= LastRow) Then
Range("A2").CurrentRegion.Copy
Sheets("Sheet1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
End If
End Sub
PasteSpecial is a method of the Range object, not the Worksheet object (which is where you are currently using it).
For example, your call should look like:
' Paste the current clipboard contents to cell B2 on Sheet1.
Sheets("Sheet1").Range("B2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
use something like below
Sub Copy_Filter1()
Sheets("Sheet1").Range("A1:A1000").Select
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet1").Range("A1").CurrentRegion.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=">=104"
If (Range("A" & Rows.Count).End(xlUp).Row <= LastRow) Then
Range("A2").CurrentRegion.Copy
Sheets("Sheet1").Range("C3").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If
End Sub
I am trying to Fill a formula that I have in D1 and fill down D to the length of C. I am using the follwing macro and I am getting the following error - Compile Error: Expected end with
Sub Macro3()
Macro3 Macro
Range("D1").Select
ActiveCell.FormulaR1C1 = "=RC[-2]*(-1)+RC[-1]"
Range("D1").Select
Dim LastRow As Long
With Sheets("Sheet2")
LastRow = Range("C" & Rows.Count).End(xlUp).Row
Range("D1").AutoFill Destination:=Range("D2:D" & LastRow)
End Sub
Your problem was a simple one. I used the macro recorder to AutoFill a Formula Range and found that the Destination Range starts with the Formula Range, so
Range("D1").AutoFill Destination:=Range("D2:D" & LastRow)
Should be:
Range("D1").AutoFill Destination:=Range("D1:D" & LastRow)
Here is working code, both fixed and cleaned up a bit :)
Sub Macro3()
With Sheets("Sheet1")
Dim LastRow As Long
LastRow = Range("C" & Rows.Count).End(xlUp).Row
With Range("D1")
.FormulaR1C1 = "=RC[-2]*(-1)+RC[-1]"
.AutoFill Destination:=Range("D1:D" & LastRow)
End With
End With
End Sub