clever minds.
I've been working on my code for a while now and there is something weird I do not understand.
But first, let me explain to you what is the situation and what I want my VBA code to do.
I have an Excel spreadsheet with several sheets. One sheet = one business unit of my company.
In each of these sheets, there is a table with data related to the business unit.
I've been coding a VBA program whose goal is to take the data from each table and put them in the same table in a sheet named "All".
It "works" but there is one scenario that can break my code. It is when one of my tables has only one row of data.
Everything works when my tables have no data at all or at least 2 or more. But not if one of them has only one row. And I don't understand why.
Here is my full code:
Sub Final_Macro()
'
' Total_Test1 Macro
'Voir clearcontent pour effacer
Dim LastRow As Long
Dim LastRowCount As Long
Sheets("All").Select
Range("A3:DZ50000").ClearContents
Application.Goto Reference:="Ref_EPG" 'Goes to the Ref_EPG table and selects it
If Not IsEmpty(ActiveCell.Value) Then
Selection.Copy 'Copies the Ref_EPG table
Sheets("All").Select 'Goes to the "All" tab
Range("A3").Select 'Selects cell A3
ActiveSheet.Paste 'Paste the Reference Numbs in the rows
Range("B3").Select 'Selects cell B3
Application.CutCopyMode = False 'Clears the clipboard
ActiveCell.FormulaR1C1 = _
"=IF(LEN(VLOOKUP(RC1,EPG_Table,EPG!R1C,FALSE))=0,"""",VLOOKUP(RC1,EPG_Table,EPG!R1C,FALSE))" 'Sets up the VLOOKUP function and if there is nothing in the source cell, returns blank instead of 0.
LastRowCount = Sheets("All").Range("A" & Rows.Count).End(xlUp).Rows.Count 'Determines the last row used in column A
LastRow = Sheets("All").Range("A" & Rows.Count).End(xlUp).Row
If LastRowCount > 1 Then
Sheets("All").Range("B3").AutoFill Destination:=Sheets("All").Range("B3:B" & LastRow) 'Autofills the VLOOKUP function from B3 to the last used row of Ref_Numbers
End If
End If
'Now let's do the same with Insulation
Dim LastRow2 As Long
Application.Goto Reference:="Ref_IG" 'Goes to the Ref_IG table and selects it
If Not IsEmpty(ActiveCell.Value) Then
Selection.Copy 'Copies the Ref_IG table
Sheets("All").Select 'Goes to the "All" tab
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'For Ref_Numbers This function is used to automatically go to the last cell of the table that doesn't have content in it. Should help avoiding overwriting rows
ActiveSheet.Paste 'Paste the Reference Numbs in the rows
'ActiveCell.Offset(0, 1).Select this line is a possible alternative to the next one. The result is the same but just works differently
Range("B" & Rows.Count).End(xlUp).Offset(1).Select 'Selects the last cell of column B that is not used yet
ActiveCell.FormulaR1C1 = _
"=IF(LEN(VLOOKUP(RC1,IG_Table,IG!R1C,FALSE))=0,"""",VLOOKUP(RC1,IG_Table,IG!R1C,FALSE))" 'Sets up the VLOOKUP function and if there is nothing in the source cell, returns blank instead of 0.
Application.CutCopyMode = False 'Clears the clipboard
LastRow2 = Sheets("All").Range("A" & Rows.Count).End(xlUp).Rows.Count 'Determines the last row used in column A
Range("B" & Rows.Count).End(xlUp).Offset(0).Select
If LastRow2 - LastRow > 1 Then
ActiveCell.AutoFill Destination:=Sheets("All").Range(ActiveCell.Address & ":B" & LastRow2) 'Autofills the VLOOKUP function from the last B cell used to the last used row of Ref_Numbers
End If
End If
'Now let's do the same with Gypsum
Dim LastRow3 As Long
Application.Goto Reference:="Ref_GYPCLG" 'Goes to the Ref_GYP table and selects it
If Not IsEmpty(ActiveCell.Value) Then
Selection.Copy 'Copies the Ref_GYPCLG table
Sheets("All").Select 'Goes to the "All" tab
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'For Ref_Numbers This function is used to automatically go to the last cell of the table that doesn't have content in it. Should help avoiding overwriting rows
ActiveSheet.Paste 'Paste the Reference Numbs in the rows
Range("B" & Rows.Count).End(xlUp).Offset(1).Select 'Selects the last cell of column B that is not used yet
Application.CutCopyMode = False 'Clears the clipboard
LastRow3 = Sheets("All").Range("A" & Rows.Count).End(xlUp).Rows.Count 'Determines the last row used in column A
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = _
"=IF(LEN(VLOOKUP(RC1,GYPCLG_Table,GYPCLG!R1C,FALSE))=0,"""",VLOOKUP(RC1,GYPCLG_Table,GYPCLG!R1C,FALSE))" 'Sets up the VLOOKUP function and if there is nothing in the source cell, returns blank instead of 0.
If LastRow3 - LastRow2 > 1 Then
ActiveCell.AutoFill Destination:=Sheets("All").Range(ActiveCell.Address & ":B" & LastRow3) 'Autofills the VLOOKUP function from the last B cell used to the last used row of Ref_Numbers
End If
End If
'Now let's do the same with Glass Solutions
Dim LastRow4 As Long
Application.Goto Reference:="Ref_GLASS" 'Goes to the Ref_GLASS table and selects it
If Not IsEmpty(ActiveCell.Value) Then
Selection.Copy 'Copies the Ref_GLASS table
Sheets("All").Select 'Goes to the "All" tab
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'For Ref_Numbers This function is used to automatically go to the last cell of the table that doesn't have content in it. Should help avoiding overwriting rows
ActiveSheet.Paste 'Paste the Reference Numbs in the rows
Range("B" & Rows.Count).End(xlUp).Offset(1).Select 'Selects the last cell of column B that is not used yet
Application.CutCopyMode = False 'Clears the clipboard
LastRow4 = Sheets("All").Range("A" & Rows.Count).End(xlUp).Rows.Count 'Determines the last row used in column A
'Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = _
"=IF(LEN(VLOOKUP(RC1,GLASS_Table,GLASS!R1C,FALSE))=0,"""",VLOOKUP(RC1,GLASS_Table,GLASS!R1C,FALSE))" 'Sets up the VLOOKUP function and if there is nothing in the source cell, returns blank instead of 0.
If LastRow4 - LastRow3 > 1 Then
ActiveCell.AutoFill Destination:=Sheets("All").Range(ActiveCell.Address & ":B" & LastRow4) 'Autofills the VLOOKUP function from the last B cell used to the last used row of Ref_Numbers
End If
End If
'Now let's do the same with Holdings
Dim LastRow5 As Long
Application.Goto Reference:="Ref_HOLD" 'Goes to the Ref_GLASS table and selects it
If Not IsEmpty(ActiveCell.Value) Then
Selection.Copy 'Copies the Ref_INSU table
Sheets("All").Select 'Goes to the "All" tab
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'For Ref_Numbers This function is used to automatically go to the last cell of the table that doesn't have content in it. Should help avoiding overwriting rows
ActiveSheet.Paste 'Paste the Reference Numbs in the rows
Range("B" & Rows.Count).End(xlUp).Offset(1).Select 'Selects the last cell of column B that is not used yet
Application.CutCopyMode = False 'Clears the clipboard
LastRow5 = Sheets("All").Range("A" & Rows.Count).End(xlUp).Rows.Count 'Determines the last row used in column A
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = _
"=IF(LEN(VLOOKUP(RC1,HOLD_Table,HOLD!R1C,FALSE))=0,"""",VLOOKUP(RC1,HOLD_Table,HOLD!R1C,FALSE))" 'Sets up the VLOOKUP function and if there is nothing in the source cell, returns blank instead of 0.
If LastRow5 - LastRow4 > 1 Then
ActiveCell.AutoFill Destination:=Sheets("All").Range(ActiveCell.Address & ":B" & LastRow5) 'Autofills the VLOOKUP function from the last B cell used to the last used row of Ref_Numbers
End If
End If
Sheets("All").Select
Dim LastRow6 As Long
Dim LastColumn As Long
LastColumn = Sheets("All").Range("B2:DC2" & Columns.Count).End(xlToLeft).Row
LastRow6 = Range("B" & Rows.Count).End(xlUp).Row
Range("B3:B" & LastRow6).Select
Selection.AutoFill Destination:=Sheets("All").Range(ActiveCell.Address & ":DC" & LastRow6), Type:=xlFillDefault 'Autofills the formulas in the column selected to the right untill column DB which is the last header of the table
Range("B3").Select
End Sub
And here's the part of the code that I want to change because it doesn't work when my table has only one row of data :
Dim LastRow5 As Long
Application.Goto Reference:="Ref_HOLD" 'Goes to the Ref_HOLD table and selects it
If Not IsEmpty(ActiveCell.Value) Then
Selection.Copy 'Copies the Ref_INSU table
Sheets("All").Select 'Goes to the "All" tab
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'For Ref_Numbers This function is used to automatically go to the last cell of the table that doesn't have content in it. Should help avoiding overwriting rows
ActiveSheet.Paste 'Paste the Reference Numbs in the rows
Range("B" & Rows.Count).End(xlUp).Offset(1).Select 'Selects the last cell of column B that is not used yet
Application.CutCopyMode = False 'Clears the clipboard
LastRow5 = Sheets("All").Range("A" & Rows.Count).End(xlUp).Rows.Count 'Determines the last row used in column A
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = _
"=IF(LEN(VLOOKUP(RC1,HOLD_Table,HOLD!R1C,FALSE))=0,"""",VLOOKUP(RC1,HOLD_Table,HOLD!R1C,FALSE))" 'Sets up the VLOOKUP function and if there is nothing in the source cell, returns blank instead of 0.
If LastRow5 - LastRow4 > 1 Then
ActiveCell.AutoFill Destination:=Sheets("All").Range(ActiveCell.Address & ":B" & LastRow5) 'Autofills the VLOOKUP function from the last B cell used to the last used row of Ref_Numbers
End If
End If
This portion of my code is used multiple times throughout my program for each business unit of my company.
Everything runs fine in this code until I reach this part of the code:
If LastRow5 - LastRow4 > 1 Then
ActiveCell.AutoFill Destination:=Sheets("All").Range(ActiveCell.Address & ":B" & LastRow5) 'Autofills the VLOOKUP function from the last B cell used to the last used row of Ref_Numbers
End If
The idea here is that I want to put a VLOOKUP formula in my cell (in column B), and if my source table has several rows, the VBA program is supposed to drag the VLOOKUP formula down for each lines that I have in my source table.
To know how many cells needs be filled with the formula, I use two variables, LastRow5 and LastRow4.
By making the difference between these two variables, I know how many cells need to be filled when dragging the VLOOKUP formula down.
That is why I say, if LastRow5 - LastRow4 > 1. Because If there is only one line in my source table, there is no need to drag the formula down.
Do you have any idea why this code doesn't work when my source table has only one row of data? There is something wrong in my code but I don't know what.
Thank you for your help, if you need any additional information to better understand the situation, do not hesitate.
Your calculation of the last row is incorrect:
LastRow5 = Sheets("All").Range("A" & Rows.Count).End(xlUp).Rows.Count
should be
LastRow5 = Sheets("All").Range("A" & Rows.Count).End(xlUp).Row
There is no need to AutoFill, or to Select, or to use ActiveCell. Write the formula to the entire range in one step:
With Sheets("All")
Dim LastRow As Long
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Dim FirstRow As Long
FirstRow = .Range("B" & .Rows.Count.End(xlUp).Offset(1).Row
.Range("B" & FirstRow & ":B" & LastRow).FormulaR1C1 = _
"=IF(LEN(VLOOKUP(RC1,HOLD_Table,HOLD!R1C,FALSE))=0,"""",VLOOKUP(RC1,HOLD_Table,HOLD!R1C,FALSE))"
End With
I am quite new to VBA, I am making a macro where it copies data from 'Sample' workbook to 'Etracker' workbook. After copying cell "H11" from 'Sample' to the last row of C column in Etracker, I want C column to autofill down to until where data is in J column. the code works but where it says "C16926" now, it changes every time because I constantly entering data into it. so I want to autofill it from last row in column C all the time.
I tried different ways to change "C16926" to vary but it doesn't seem to work.
Please help! and thanks in advance.
LastrowC = Etracker.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
LastrowJ = Etracker.Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).Row
Sample.Activate
Range("H11").Copy
Etracker.Cells(LastrowC, 3).PasteSpecial xlPasteValues
Etracker.Activate
Etracker.Range("C" & LastrowC).Select
Selection.AutoFill Destination:=Range("C16926:C" & Range("J" & Rows.Count).End(xlUp).Row), Type:=xlFillCopy
You just need to concatenate your last row into the address like
"C" & LastrowC & ":C" & Range("J" & Rows.Count).End(xlUp).Row)
Note that you don't need to .Select or .Activate if you specify a worksheet for every Range, Cells, Rows and Columns object. Using .Select or .Activate is very unreliable and makes your code really slow.
So you should end up with something like
Dim LastRowC As Long
LastrowC = Etracker.Cells(Etracker.Rows.Count, "C").End(xlUp).Offset(1, 0).Row
Dim LastrowJ As Long
LastrowJ = Etracker.Cells(Etracker.Rows.Count, "J").End(xlUp).Offset(1, 0).Row
Sample.Range("H11").Copy
Etracker.Cells(LastrowC, "C").PasteSpecial xlPasteValues
Etracker.Range("C" & LastrowC).AutoFill Destination:=Etracker.Range("C" & LastrowC & ":C" & LastrowJ), Type:=xlFillCopy
I have two worksheets, named "Monthly" and "Index", in a workbook.
In Index, cell A1 will have a value after some calculations.
I need to copy that value into "Monthly" Column "J".
It shall be one by one using next row coding.
Private Sub CommandButton2_Click()
Dim i As Integer
a = Worksheets("Monthly").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
Range("K" & i).Copy Worksheets("Rule of 78").Range("D6")
'Range("A1").Offset(i - 1, 0).Copy Range("C1")
Range("I" & i).Copy Worksheets("Rule of 78").Range("D7")
Range("E" & i).Copy Worksheets("Rule of 78").Range("D8")
Range("A" & i).Copy Worksheets("Rule of 78").Range("D10")
Worksheets("Index").Range("C2").Copy " How to paste in Monthly sheet
column J, for every row, C2 is different"
Next i
End Sub
Does "A1" have a formula? If so Excel is probably copying a formula, thus the error.
Try:
Worksheets("Index").Range("A1").Copy
Worksheets("Monthly").Range("J" & i).PasteSpecial xlPasteValues
Edit: "A1" or "C2", I didn't get wich is giving you the error.
I have no experience with VBA and it's proving to be more difficult than what I imagined...in part because I don't know the syntax, but I have the following:
Sub testMe()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Worksheets("Sheet2").Range("A1").Copy Destination:=Range("A" & LastRow)
End Sub
This kinda works, but it's jamming everything into one cell in the first column. How do I merge the cells of the last row before pasting into it? The macro is supposed to find the last row of the last page, merge the cells of that row, and paste text that was copied from another cell. Thank you in advance.
This should do what you're after. You should just change the column number to reflect the column which you wish to merge cells until.
Option Explicit
Sub copy_and_paste_merge()
Dim last_row As Long
last_row = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(1, 1).Copy
Cells(last_row, 1).PasteSpecial Paste:=xlPasteValues
Range(Cells(last_row, 1), Cells(last_row, 5)).MergeCells = True 'change the column
End Sub
I ended up doing it like this...
Sub testMe()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A" & LastRow & ":L" & LastRow).Merge
Range("A" & LastRow) = Worksheets("Sheet2").Range("A1")
End Sub
PasteValues is the most frustrating thing in VBA! Could greatly use some help.
In short, I am trying to copy one row and pastespecial values that row into another row on a separate sheet. I thought it was a row issue, so I then modified my range and tried pasting that, also to no avail. I even tried recording a macro and the generated code is almost the exact same as mine.
Can someone please help? I've been looking at this too long :/
Sub CopyXs()
Dim counter As Double
Dim CopyRange As String
Dim NewRange As String
counter = 2
For Each Cell In ThisWorkbook.Sheets("LD_Tracker_CEPFA").Range("A7:A500")
If Cell.Value = "X" Then
Sheets("Upload_Sheet").Select
matchrow = Cell.Row
counter = counter + 1
Let CopyRange = "A" & matchrow & ":" & "Y" & matchrow
Let NewRange = "A" & counter & ":" & "Y" & counter
Range(CopyRange).Select
Selection.Copy
Sheets("Final_Upload").Select
ActiveSheet.Range(NewRange).Select
Selection.PasteSpecial Paste = xlPasteValues
Sheets("Upload_Sheet").Select
End If
Next
End Sub
I was struggling also with Paste.Special. This code works for me. The code you get when you record a macro for Paste.Special is not working. You first have to define a range and then used the code for Paste.Special
Range(something).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'This code works for me:
'**Select everything on the active sheet**
Range("A1").Select
Dim rangeTemp As Range
Set rngTemp = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not rngTemp Is Nothing Then Range(Cells(4, 1), rngTemp).Select
End if
' **Copy the selected range**
Selection.Copy
'**Select the destination and go to the last cel in column A and then go 2 cells down
'and paste the values**
Sheets("your sheet name").Select
Range("A" & Cells.Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
**'Select the last cell in column A**
Range("A" & Cells.Rows.Count).End(xlUp).Select