All of the variables are defined correctly. This works till it gets to the final statement shown and then it says
"Paste method of Worksheet class failed".
Set TargetSheet = ActiveSheet
For Each cell In TargetSheet.Columns(1).Cells
If IsEmpty(cell) = True Then FirstRow = cell.Row: Exit For
Next cell
LastRow = FirstRow + 6
Sheets(ClientName).Range("A3:Q9").Copy
With Sheets("4 Policies")
.Activate
.Range("A" & FirstRow).Select
ActiveSheet.Paste Link:=True
End With
Try this
Set TargetSheet = ActiveSheet
For Each cell In TargetSheet.Columns(1).Cells
If IsEmpty(cell) = True Then FirstRow = cell.Row: Exit For
Next cell
LastRow = FirstRow + 6
Sheets("4 Policies").Range("A" & FirstRow).Resize(7, 17).Formula = "=" & ClientName & "!A3"
If you trying to find the cell below the last used one in column A, your code becomes
FirstRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheets("4 Policies").Range("A" & FirstRow).Resize(7, 17).Formula = "=" & ClientName & "!A3"
or, if the active sheet is "4 Policies"
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(7, 17).Formula = "=" & ClientName & "!A3"
Related
I'm not sure why my macro is starting this =TRIM(F2) formula in cell E1 instead of E2.
'Insert TRIM Contract Column & formula
Set rngHeaders = Range("1:1") 'Looks in entire first row
Set rngUsernameHeader = rngHeaders.Find(what:="Contract", After:=Cells(1, 1))
rngUsernameHeader.EntireColumn.Insert
Range("E1").Value = "TRIM CONTRACT"
Range("E1").Font.Bold = True
Range("E2").Select
Dim lastRow As Long
lastRow = Range("E2:E" & Rows.Count).End(xlUp).Row
Range("E2:E" & lastRow) = _
"=TRIM(F2)"
Range("E2:E" & lastRow).Select
Range("E2:E" & Range("F" & Rows.Count).End(xlUp).Row).FillDown
I'm just trying to insert a column (column E) that contains the TRIM values in the column next to it (column F, aka 'Contract')
This should work, I also removed all unnecessary lines:
Option Explicit
Sub Macro3()
'Insert TRIM Contract Column & formula
Set rngHeaders = Range("1:1") 'Looks in entire first row
Set rngUsernameHeader = rngHeaders.Find(what:="Contract", After:=Cells(1, 1))
rngUsernameHeader.EntireColumn.Insert
Range("E1").Value = "TRIM CONTRACT"
Range("E1").Font.Bold = True
Dim lastRow As Long
lastRow = Range("F" & Rows.Count).End(xlUp).Row
Range("E2:E" & lastRow) = "=TRIM(F2)"
End Sub
Cheers .
Followup:
If you don't know what column is going to contain "Contract" you need to make all further cell references related to your found cell:
Option Explicit
Sub Insert_Formula_Found_Column()
'Insert TRIM Contract Column & formula
Dim RngHeaders As Range
Dim RngUserNameHeader As Range
Dim BuiltFormula As String
Set RngHeaders = Range("1:1") 'Looks in entire first row
Set RngUserNameHeader = RngHeaders.Find(what:="Contract", After:=Cells(1, 1))
RngUserNameHeader.EntireColumn.Insert
RngUserNameHeader.Offset(0, -1).Value = "TRIM CONTRACT"
RngUserNameHeader.Offset(0, -1).Font.Bold = True
Dim lastRow As Long
lastRow = RngUserNameHeader.Offset(Rows.Count - 1, 0).End(xlUp).Row
BuiltFormula = "=TRIM(" & Replace(RngUserNameHeader.Offset(1, 0).Address, "$", "") & ")"
RngUserNameHeader.Offset(1, -1).Resize(lastRow).Formula = BuiltFormula
End Sub
I'm entering a value in the last blank cell (as I can't do the last row in a column) due to other data being there. I was to add the sum of all the above cells to each column.
The number of columns is variable as is the number of names
I've been able to add the relevant formula but I can't get it to copy across in the same way my other code did.
This is the line with the error, to copy to the last used column, everything else works except this bit.
Range("O" & nextfree).AutoFill Range("O" & nextfree, Cells("O" & nextfree, lastcolumn))
I get a run type error 13, Type mis-match.
The full code is here
Sub addrow()
'Checks the number of users then adds them to the active sheet section
Dim rowsToAdd As Integer
Dim lastcolumn As Long
Dim lastRow As Long
Dim ws As Worksheet, ws1 As Worksheet
Set ws = ThisWorkbook.Worksheets("Refs")
Set w1 = ThisWorkbook.Worksheets("Active events")
With ws
lastRow = Sheets("Refs").Cells(.Rows.Count, "A").End(xlUp).Row
lastcolumn = Sheets("Active events").Cells.Find("*", searchorder:=xlByColumns, SearchDirection:=xlPrevious).Column
MsgBox lastRow - 1
MsgBox lastcolumn
End With
With ws1
Rows("5:5").Resize(lastRow - 1).Insert Shift:=xlDown ' minus 2 to account for header row and also existing text in row 4
End With
Worksheets("Refs").Range("A2:A" & lastRow).Copy Worksheets("Active events").Range("M4")
Range("O4:O" & lastRow + 2).Formula = "=SUMIF($C$14:$C$5032,$M4,O$14:O$5032)"
Range("O4:O" & lastRow + 2).AutoFill Range("O4", Cells(lastRow + 2, lastcolumn))
'Find the next blank cell in the names range and adds totals and the sum value to all columns
nextfree = Range("M4:M" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("M" & nextfree).Value = "Total"
Range("O" & nextfree).Value = "=SUM(O4:O" & nextfree - 1 & ")"
'Problem code here
Range("O" & nextfree).AutoFill Range("O" & nextfree, Cells("O" & nextfree, lastcolumn))
End Sub
I am attempting to copy Columns D & E from the last row to the next row. Currently I am getting a Compile Error: Type Mismatch. I've been fighting this all day with different ways of going about it. Any help would be appreciated.
Sub PTB()
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
End With
Dim lastCellCoords As String: lastCellCoords = "D" & LastRow & ":E" & LastRow
Dim firstEmptyRow As Integer: firstEmptyRow = LastRow + 1
Dim firstEmptyCoords As String: firstEmptyCoords = "D" & firstEmptyRow & ":E" & firstEmptyRow
If Not LastRow Is Nothing Then
' Now Copy the range:
Worksheets("Survey").Range(lastCellCoords).Copy
' And paste to first empty row
Worksheets("Survey").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
MsgBox ("There is no data in specified range")
End If
End Sub
I'm trying to insert this character "-" at the beginning of each text in column F.
My F column looks like this:
BP850
BP851
BT100
GP160
GP161
I tried this code:
Option Explicit
Sub test()
Dim LastRow As Long, i As Long
Dim str As String
'Change sheet if needed
With ThisWorkbook.Worksheets("Sheet1")
'Find the last row of column F
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
'Loop column F
For i = 1 To LastRow
'Replace the first occurance
str = Replace(.Range("F" & i).Value, "", "-", 1, 1)
.Range("F" & i).Value = str
Next i
End With
End Sub
I expect:
-BP850
-BP851
-BT100
-GP160
-GP161
As an alternative, you could try to utilize .Evaluate. This prevents the need for any loop:
Option Explicit
Sub test()
Dim LastRow As Long
Dim rng As Range
'Change sheet if needed
With ThisWorkbook.Worksheets("Sheet1")
'Find the last row of column F
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
Set rng = .Range("F1:F" & LastRow)
rng.Value = .Evaluate("""'-""&" & rng.Address)
End With
End Sub
Instead of using replace, just concatenate "-" before str
Sub test()
Dim LastRow As Long, i As Long
Dim str As String
'Change sheet if needed
With ThisWorkbook.Worksheets("Sheet1")
'Find the last row of column F
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
'Loop column F
For i = 1 To LastRow
'Replace the first occurance
str = "-" & .Range("F" & i).Value '<== EDIT
.Range("F" & i).Value = str
Next i
End With
End Sub
Your str = Replace(.Range("F" & i).Value, "", "-", 1, 1) has problem. Change it to following:
For i = 1 To LastRow
.Range("F" & i).Value = "-" & .Range("F" & i).Value
Next i
No need to use str variable here.
See if following approach helps.
It will also check
Cell is not blank
Cell doesn't begin with "-"
which should help in case of accidental rerun of the macro!
Option Explicit
Sub test2()
Dim LastRow As Long, i As Long
'Change sheet if needed
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Sheet1")
'Find the last row of column F
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
'Loop column F
For i = 1 To LastRow
If Len(.Range("F" & i).Value) > 0 And Left(.Range("F" & i).Value, 1) <> "-" Then _
.Range("F" & i).Value = "-" & .Range("F" & i).Value
Next i
End With
Application.ScreenUpdating = True
End Sub
try this, ie. add "'-" in front of the value. Note the single quote before the -
For i = 1 To lastRow
If .Range("F" & i).Value <> "" Then
If Left(.Range("F" & i).Value, 1) <> "-" Then
.Range("F" & i).Value = "'-" & .Range("F" & i).Value
End If
End If
Next i
Option Explicit
Sub test()
Dim LastRow As Long, i As Long
Dim AdditionString As String, CellString As String, CompleteString As String
AdditionString = "'-"
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
CellString = .Range("A" & i).Value
CompleteString = AdditionString & CellString
.Range("A" & i).Value = CompleteString
Next i
End With
End Sub
I'm trying to write a short macro that includes a line that averages a range of cells. In each worksheet that I want to run the macro in the range of cells is a different length.
After running the macro the cell E1 contains "=AVERAGE(Rng)"
Dim homeSheet As Worksheet
Set homeSheet = ActiveSheet
Dim lastRow As Long
Dim Rng As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("B2:B" & lastRow)
Range("E1").Formula = "=Average(Rng)"
Range("E2").Formula = "=STDEV(Rng)"
Range("E3").Select
ActiveWindow.SmallScroll Down:=-2
End Sub
I've also tried
Range("E1").Formula = "=Average(Range("B2:B" & lastRow))"
without trying to use Set Rng = Range("B2:B" & lastRow)
You need to use Rng.Address in your formulas. Try to change your code into this:
Sub Avg()
Dim homeSheet As Worksheet
Set homeSheet = ActiveSheet
Dim lastRow As Long
Dim Rng As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("B2:B" & lastRow)
Range("E1").Formula = "=Average(" & Rng.Address & ")"
Range("E2").Formula = "=STDEV(" & Rng.Address & ")"
Range("E3").Select
End Sub
If you were to use the second method you have tried, you would need to change that line of code to:
Range("E1").Formula = "=Average(" & Range("B2:B" & lastRow).Address & ")"