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
Related
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 trying to copy 3 entire rows below a cell which includes a text.
I've already wrote this but there are some issues that I can't solve due to being a beginner of VBA.
Option Explicit
Private Sub SearchandInsertRows()
Dim lRow As Long, iRow As Long
With Worksheets("Main_Page")
lRow = .Cells(.Rows.Count, "A").End(xlup).Row
For iRow = lRow to 1 Step -1
If .Cells(iRow, "A").Value = Range("D5") Then
.Rows(iRow).Resize(3).Insert
End if
Next iRow
End With
End Sub
I want excel to read the entire A column and find the cell which has same text with cell D5 (Text is BillNumber). Then add 3 blank rows above that. Lastly copy the three cells below BillNumber and paste it to recently created 3 blank rows.
Here is screenshot to make it more understandable.
Here is one way, remove the MsgBox lines, they are for debugging.
Sub insertPaste()
Dim D5Val As String, wk As Workbook, fVal As Range
Set wk = ThisWorkbook
With wk.Sheets("Sheet1")
'Value from D5
D5Val = .Range("D5").Value
'Find D5 on column A
Set fVal = .Columns("A:A").Find(D5Val, , xlValues, , xlNext)
If fVal Is Nothing Then
'Not found
MsgBox "Not Found"
Else
'Found
MsgBox "Found at: " & fVal.Address
'Insert 3 Cells on top of the cell found with the data from the 3 cells below
.Range("A" & (fVal.Row + 1) & ":A" & (fVal.Row + 3)).Copy
.Range("A" & fVal.Row & ":A" & (fVal.Row + 2)).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
End With
End Sub
Copy Cells Below Text Above Text
The Code
Private Sub SearchandInsertRows()
Dim lRow As Long, iRow As Long
With Worksheets("Main_Page")
lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = lRow To 1 Step -1
If .Cells(iRow, "A").Value = .Range("D6") Then
.Rows(iRow).Resize(3).Insert
.Rows(iRow + 3 & ":" & iRow + 5).Copy .Rows(iRow)
End If
Next iRow
End With
End Sub
I'm a total novice with VBA. I have the following code which does a matching exercise and then pastes the relevant values into col. B. my issue is each time the code is used the col will change how can I add this to the module so that it looks for the last cell used in row 1 and pastes the values below.
Sub TransferData()
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String
Application.ScreenUpdating = False
lastrow1 = Sheets("Input Sheet").Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow1
myname = Sheets("Input Sheet").Cells(i, "B").Value
Sheets("Data").Activate
lastrow2 = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
For j = 2 To lastrow2
If Sheets("Data").Cells(j, "A").Value = myname Then
Sheets("Input Sheet").Activate
Sheets("Input Sheet").Cells(i, "c").Copy
Sheets("Data").Activate
Sheets("Data").Cells(j, "B").Select
ActiveSheet.PasteSpecial
End If
Next j
Application.CutCopyMode = False
Next i
Application.ScreenUpdating = True
End Sub
any assistance with this would be appreciated.
You can replace your second For j = 2 To lastrow2 with the Match function.
Also, there is no need to Activate the sheets back and fourth all the time, just use fully qualified Ranges instead.
Code
Option Explicit
Sub TransferData()
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String
Dim MatchRng As Range
Application.ScreenUpdating = False
j = 2
With Sheets("Input Sheet")
lastrow1 = .Range("B" & .Rows.Count).End(xlUp).Row
' the 2 lines bellow should be outisde the loop
lastrow2 = Sheets("Data").Range("A" & Sheets("Data").Rows.Count).End(xlUp).Row
Set MatchRng = Sheets("Data").Range("A2:A" & lastrow2)
For i = 2 To lastrow1
myname = .Range("B" & i).Value
If Not IsError(Application.Match(myname, MatchRng, 0)) Then '<-- if successful Match
Sheets("Data").Range("B" & j).Value = .Range("C" & i).Value
j = j + 1
End If
Application.CutCopyMode = False
Next i
End With
Application.ScreenUpdating = True
End Sub
I am trying to retrieve data from another file using the VLOOKUP function however this is only to happen depending on if any of the 2 items of data appear in column 3(C)
"PO Materials" OR
"PO Labor"
Sub MakeFormulas()
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Dim X As Long
'What are the names of our worksheets?
Set sourceSheet = Worksheets("Sheet1")
Set outputSheet = Worksheets("Sheet2")
'Determine last row of source
With sourceSheet
SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With outputSheet
'Determine last row in col C
OutputLastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
For X = 5 To OutputLastRow
If InStr(1, .Range("C" & X), "PO Materials") > 0 Then
'Apply our formula
.Range("Q2:Q" & OutputLastRow).Formula = _
"=VLOOKUP(E2,'" & sourceSheet.Name & "'!$A$2:$B$" & SourceLastRow & ",2,0)"
End If
Next
End With
End Sub
Code is working; However, its giving #N/A if the cell is blank or contains any value in Column C, which means its not recognizing the If statement. If the column does not containn "PO Materials" or "PO Labor" I would like it to skip to the next cell in the range
Thanks in advance for any help given.
The code that generates the VLOOKUP is applying that formula to each cell in the column every time. That is, every time your If condition finds "PO Materials", it will apply the VLOOUKP to every cell between Q2 and the last row from column E.
I think this is what you want:
.Range("Q" & X).Formula = _
"=VLOOKUP(E" & X & ",'" & sourceSheet.Name & "'!$A$2:$B$" & SourceLastRow & ",2,0)"
Alternatively, it could be done completely within the spreadsheet:
=IF(ISERROR(FIND("PO Materials",C6)),"",VLOOKUP(E6,Sheet1!$A$2:$B$6,2,0))
Final Code for future reference
Sub MakeFormulas()
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Dim X As Long
'What are the names of our worksheets?
Set sourceSheet = Worksheets("Sheet1")
Set outputSheet = Worksheets("Sheet2")
'Determine last row of source
With sourceSheet
SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With outputSheet
'Determine last row in col C
OutputLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For X = 2 To OutputLastRow
If InStr(1, .Range("C" & X), "PO Materials") + InStr(1, .Range("C" & X), "PO Labor") > 0 Then
'Apply our formula
.Range("Q" & X).Formula = _
"=VLOOKUP(E" & X & ",'" & sourceSheet.Name & "'!$A$2:$B$" & SourceLastRow & ",2,0)"
End If
Next
End With
End Sub
I have a workbook containing multiple sheets of varying sizes. I want to add a total column after the last row and copy the formula across all columns. I have defined the last row and column and the formula appears as expected in the correct place but I receive an error when trying to fill across. How do I correctly reference both dynamic cells for the fill? I'm just using a single sheet for now for testing but will eventually be looping through all the sheets in the book.
Sub Addtotals()
Dim Bord As Worksheet
Dim LRow As Long
Dim LCol As Long
Dim frmcell As Range
Set Bord = Sheets("Borders")
With Bord
'--> Define last rows and columns
LRow = .Range("A" & Rows.Count).End(xlUp).Row
LCol = .Range("A" & Columns.Count).End(xlToLeft).Column
'--> Add Total text to first column
.Range("A" & LRow).Offset(1, 0).Select
ActiveCell = "Total"
'--> Add formula to next column
Set frmcell = Range("B" & LRow + 1)
frmcell.Formula = "=sum(B2:B" & LRow & ")"
'--> Fill formula across range
frmcell.Select
Selection.AutoFill Destination:=Range(frmcell & LCol), Type:=xlFillDefault
End With
End Sub
Thanks :)
Like this?
Option Explicit
Sub Addtotals()
Dim Bord As Worksheet
Dim LRow As Long, LCol As Long
Set Bord = Sheets("Borders")
With Bord
'--> Define last rows and columns
LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
LCol = .Cells(1, Columns.Count).End(xlToLeft).Column
'--> Add Total text to first column
.Range("A" & LRow).Value = "Total"
'--> Fill formula across range
.Range("B" & LRow & ":" & _
Split(Cells(, LCol).Address, "$")(1) & LRow).Formula = _
"=Sum(B2:B" & LRow - 1 & ")"
End With
End Sub