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 need to fill the formula till the last used row. I have data from A6:A28, however while using below code its dragging the formula till row 628. Issue is with 4th line of the code. Please help me correct.
Dim Lastrow As Long
Lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.Range("H6:M6").Select
Selection.AutoFill Destination:=Range("H6:M6" & Lastrow), Type:=xlFillDefault
Copy Down Formulas
A Quick Fix
Just remove the 6 after the M.
Selection.AutoFill Destination:=Range("H6:M" & LastRow), Type:=xlFillDefault
An Improvement
No Select
No variable
No AutoFill
With ActiveSheet ' improve!
With .Range("H6:M" & .Cells(.Rows.Count, "A").End(xlUp).Row)
.Formula = .Rows(1).Formula
End With
End With
I'm looking to 'normalize' a column of data by setting the minimum value to 0 and shifting the entire column's data by the difference of the min value and 0.
The code should be simple, but I can't find the appropriate range selection to stop the code when it reaches a blank cell.
Below is the core that I've unsuccessfully been working off of trying to recognize the first empty cell in column U after U9 up to U700 and correspondingly stop subtracting in column Z. Example screenshots are attached. Thank you!
Private Sub CommandButton1_Click()
[Z9:Z700] = [U9:U700-U8]
End Sub
This is what I get:
This is what I would like to get:
Try this:
Sub foo()
Dim lRow As Long
With ActiveSheet
lRow = .Cells(Rows.Count, "U").End(xlUp).Row
.Range("U9:U" & lRow).Copy .Range("Z9")
With .Range("U8")
.Formula = "=MIN(U9:U" & lRow & ")"
.Copy
End With
.Range("Z9:Z" & lRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlSubtract
Application.CutCopyMode = False
End With
End Sub
EDIT:
If you have formulas in Column U, below your list of numbers, which are returning blank values, then this revision might work better for you:
Sub foo2()
Dim lRows As Long
With ActiveSheet
lRows = WorksheetFunction.Count(.Range("U9:U700"))
.Range("U8").Formula = "=MIN(" & .Range("U9").Resize(lRows, 1).Address(0, 0) & ")"
.Range("U9").Resize(lRows, 1).Copy
.Range("Z9").PasteSpecial Paste:=xlPasteValues
.Range("U8").Copy
.Range("Z9").Resize(lRows, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlSubtract
End With
Application.CutCopyMode = False
End Sub
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
I am Comparing cells in column D and if they match paste the value of the previous cell in column B into the next cell in column B if they do not match paste the value of the subseqent cell in column A into the cell in column B
e.g
IF(D2=D3,B2,A2+1)" but this is not working after running on the 1st sequence of cells in D I get #Valve!" for the rest of column B
I am sure this is the problem IF(D2=D3,B2,A2+1)" in-particular the A2+1 reference but not sure how to call it
(Sorry if this was unclear)
Thanks
Sub TargetId()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Sheets("UnPivot")
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").FormulaR1C1 = "Source"
Range("B2").FormulaR1C1 = [A2].Value
With ws
lRow = ws.Range("D" & .Rows.Count).End(xlUp).Row
With .Range("B3:B" & lRow)
.Formula = "=IF(D2=D3,B2,A2+1)"
.Value = .Value
End With
End With
End Sub
As follow up from comments, this one works:
With .Range("B3:B" & lRow)
.Formula = "=IF(D2=D3,B2,A3)"
.Value = .Value
End With