Pasting data to new worksheet where A-E are non-empty - excel

I'm having trouble getting a copied row to paste into a different worksheet, on the first available row.
Problem is I need the data to paste into column B but my macro pastes into other columns. Column A has a Vlookup formula and columns B-E have specific drop-downs which excel sees as non-empty cells.
I don't know if this is causing the problem?
My code;
Dim iRow As Integer
Dim ws As Worksheet
Set ws = Worksheets("Dispute_Details")
ws.Activate
On Error Resume Next
iRow = Range("F:F").Find(What:=" ", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
Sheets(ws).Range("b", iRow).Activate
Worksheets("Dispute_Details").Paste
Application.CutCopyMode = False}

Dim iRow As Long
With Worksheets("Dispute_Details")
iRow = .Cells(.Rows.Count, 5).End(xlUp).Row + 1
.Range("B" & iRow).PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
End With

Related

Excel VBA: Copy data from cell above in blank cells, but only in columns A-B

I have 5 columns of data. The data is grouped by employee name and number (cols A-B) and their respective pay types (col C). I need to
Copy employee name to blank cell below in col A
Copy employee number to blank cell below in col B
Add the word "Advance" in the blank cell in col C
Current code selects all blank cells in cols A-E and fills with the values from above:
Sub FillBlanksValueAbove1()
Dim sName As String
sName = ActiveSheet.Name
Dim ws As Worksheet
Dim lastRow As Long, lastCol As Long
Dim rng As Range
'Set variable ws Active Sheet name
Set ws = Sheets(sName)
With ws
'Get the last row and last column
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
'Set the range
Set rng = .Range(.Cells(1, 1), .Cells(lastRow, lastCol))
rng.Select
'Select Blanks
rng.SpecialCells(xlCellTypeBlanks).Select
'Fill Blanks with value above
Selection.FormulaR1C1 = "=R[-1]C"
'Paste Formulas as Values
rng.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End With
End Sub
This is what the spreadsheet looks like now:
This is what I need it to look like:
This is the end result I currently get:
Thank you so so much!
Test the next code, please. No need of any selection, a little simplified:
Sub FillBlanksValueAbove1()
Dim rng As Range, rngVis As Range
Dim ws As Worksheet, lastRow As Long
'Set variable ws Active Sheet name
Set ws = ActiveSheet
With ws
'Get the last row
lastRow = .Range("A" & .Rows.count).End(xlUp).Row
'Set the range
Set rng = .Range(.cells(1, 1), .cells(lastRow, 2)) 'Col B:C
Set rngVis = rng.SpecialCells(xlCellTypeBlanks)
'Fill ADVANCE in column C:C
rngVis.Offset(, 1).Value = "ADVANCE"
'Fill Blanks with value above
rngVis.FormulaR1C1 = "=R[-1]C"
'Paste Formulas as Values
rngVis.Value = rngVis.Value
End With
End Sub

Selected range of cells via VBA doesn't work

EDITED
I would like to ask you for help & revision of my VBA code as I am new to VBA.
I have pivot table with 3 columns. Via slicer I choose the items I want to add in new data table, each item must be added 3 times - therefore in the code I used loop 3 times.
The VBA works perfectly when 2 or more items are chosen.
However, when only single item is selected, the VBA crashes because the "selected copied range" does not have the same size as "pasted range" size. Basically, it selects all cells from column "F2:H2" until the end of spreadsheet.
Sub Copy()
Dim i
For i = 1 To 3
StartRange = "F2:H2"
EndRange = "F2:H2"
Set a = Range(StartRange, Range(StartRange).End(xlDown))
Set b = Range(EndRange, Range(EndRange).End(xlDown))
Union(a, b).Select
Selection.Copy
lastrow = ActiveSheet.Cells(Rows.Count, "T").End(xlUp).Row + 1
Cells(lastrow, "T").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
End Sub
How to modify the code, if only single item is selected, it will copy the cells in new data table as well?
I can provide a test file for reference.
Use .End(xlDown) from the header row.
Option Explicit
Sub Copy()
Dim ws As Worksheet, rng As Range
Dim i As Long, lastrow As Long
Set ws = ThisWorkbook.ActiveSheet
Set rng = ws.Range("F2", ws.Range("H1").End(xlDown))
For i = 1 To 3
lastrow = ws.Cells(Rows.Count, "T").End(xlUp).Row + 1
rng.Copy
ws.Cells(lastrow, "T").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
End Sub
or to copy single rows
Sub Copy2()
Const REPEAT = 3
Dim ws As Worksheet, rng As Range
Dim row As Range, lastrow As Long
Set ws = ThisWorkbook.ActiveSheet
Set rng = ws.Range("F2", ws.Range("H1").End(xlDown))
lastrow = ws.Cells(Rows.Count, "T").End(xlUp).row + 1
For Each row In rng.Rows
If Not row.Hidden Then
ws.Cells(lastrow, "T").Resize(REPEAT, row.Columns.Count).Value = row.Value
lastrow = lastrow + REPEAT
End If
Next
End Sub

How to copy the full row from one sheet to another if the column C is marked as Y

I have three sheets in a workbook and I want to copy all the rows from all the first three sheets into sheet 4 which has the column 'C' marked as Y.
I'm answering this question, because I'm bored.
The code below assigns the worksheets to filter to an array, loops thru the array, filters the range, then copies the visible cells in the filter data. If "A1" is empty; it will paste the copied data from each worksheet to Range("A1"), else it will paste the data to the first empty cell in "column A". Change the worksheet names as required.
Sub FltrPste()
Dim wb As Workbook, shtArr As Variant, wsDest As Worksheet, i As Long, lRow4 As Long
Set wb = ThisWorkbook
shtArr = Array("Sheet1", "Sheet2", "Sheet3")
Set wsDest = wb.Sheets("Sheet4")
lRow = wsDest.Range("A" & Rows.Count).End(xlUp).Row
For i = LBound(shtArr) To UBound(shtArr)
With wb.Sheets(shtArr(i)).Range("A1").CurrentRegion
.AutoFilter
.AutoFilter Field:=3, Criteria1:="y"
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
If Range("A1") = "" Then
wsDest.Cells(1, 1).PasteSpecial xlPasteValues
Else
wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
.AutoFilter
End With
Next i
End Sub

Excel VBA Macro Create Pivot Table with Dynamic Data Range: Source Data Range Error

I am new to VBA coding and trying to create an Excel macro which will create a pivot table based on a dynamic data range. I am using Excel 2016.
The number of columns in the data will remain the same but the number of rows is dynamic.
In my data worksheet, column BZ contains a count of how many records are in the dataset. E.g. If there are 30 records in the dataset, every value in column BZ will be 30. (This data is imported from SAS using DDE which is why I have chosen this method). I have therefore added 1 onto the lastRow variable below to include column names.
My VBA Macro code is currently as follows:
Sub Macro1()
Dim xlsPath As String
Dim xlsFile As String
Dim lastRow As Integer
Dim SrcData As String
Dim StartPvt As String
Dim pvtCache As PivotCache
Dim pvt As PivotTable
xlsxPath = "N:\Analytics\Test\DDE\"
xlsxFile = "Test.xlsx"
lastRow = Sheets(1).Range("BZ2") + 1
SrcData = ActiveSheet.Name & "!" & Range("A1:R" & lastRow & "C77").Address(ReferenceStyle:=xlR1C1)
StartPvt = sht.Name & "!" & sht.Range("A3").Address(ReferenceStyle:=xlR1C1)
Workbooks.Open Filename:=xlsxPath & xlsxFile
Range("A1:BY" & lastRow).Select
Sheets.Add
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData, Version:=6)
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvt, _
TableName:="PivotTable1", DefaultVersion:=6)
Columns("BZ:BZ").Select
Selection.Delete Shift:=xlToLeft
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
This produces an error which says:
Run-time error '1004':
Method 'Range' of 'object'_Global' failed
The debugger points to the line where the SrcData range is determined. I think the issue may be syntax, where I have specified the lastRow within Range.
A solution for this line of code, or any other helpful comments would be greatly appreciated.
You can turn on the Macro Recorder, then click anywhere in your dataset and Excel will automatically select the last used column and last used row in that dataset, just before creating a Pivot Table. Try it and you will see. If you want to use VBA to dynamically select the last row and dynamically select the last column, and check out the code below.
Ways To Find The Last Row
Sub FindingLastRow()
'PURPOSE: Different ways to find the last row number of a range
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ActiveSheet
'Using Find Function (Provided by Bob Ulmas)
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'Using SpecialCells Function
LastRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row
'Ctrl + Shift + End
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
'Using UsedRange
sht.UsedRange 'Refresh UsedRange
LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
'Using Table Range
LastRow = sht.ListObjects("Table1").Range.Rows.Count
'Using Named Range
LastRow = sht.Range("MyNamedRange").Rows.Count
'Ctrl + Shift + Down (Range should be first cell in data set)
LastRow = sht.Range("A1").CurrentRegion.Rows.Count
End Sub
Ways To Find The Last Column:
Sub FindingLastColumn()
'PURPOSE: Different ways to find the last column number of a range
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim LastColumn As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
'Ctrl + Shift + End
LastColumn = sht.Cells(7, sht.Columns.Count).End(xlToLeft).Column
'Using UsedRange
sht.UsedRange 'Refresh UsedRange
LastColumn = sht.UsedRange.Columns(sht.UsedRange.Columns.Count).Column
'Using Table Range
LastColumn = sht.ListObjects("Table1").Range.Columns.Count
'Using Named Range
LastColumn = sht.Range("MyNamedRange").Columns.Count
'Ctrl + Shift + Right (Range should be first cell in data set)
LastColumn = sht.Range("A1").CurrentRegion.Columns.Count
End Sub
You can easily incorporate this into the code you already have.

Copying selective columns data till data in column 1 ends

I am currently using the following code to copy paste data from File- "Source" to File-"Destination". It is selecting the rows till data ends in Column-1.
However, currently all the columns from A to AE are selected, but instead I want selective columns like A,F,K,AA to be selected.
I understand that the code in "wb.ActiveSheet.Range("A2:AE" & N).Copy" needs to be changed but not sure of the syntax.
Can anyone help me with this? Appreciate the help in advance.
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim N As Long
Dim LastRow As Long
N = Cells(2, 1).End(xlDown).Row
wb.ActiveSheet.Range("A2:AE" & N).Copy
Set y = Workbooks.Open("C:\Desktop\Destination.xlsx")
y.Activate
y.Sheets("Data").Select
y.Sheets("Data").Activate
For Each Cell In y.Sheets("Data").Columns(1).Cells
If Len(Cell) = 0 Then Cell.Select: Exit For
Next Cell
Selection.PasteSpecial Paste:=xlPasteValues
Application.DisplayAlerts = False
ActiveWorkbook.Close True
Application.DisplayAlerts = True
Application.CutCopyMode = False
You can use the Application.Union to combine ranges from different columns (from row 2 until N).
Also, instead of looping through your y.Sheets("Data").Columns(1).Cells to find the empty Cell, you can just use LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1.
I added 2 With wb.Sheets("Sheet1") to fully qualify all variables and Range nested underneath.
Code
Option Explicit
Sub CopyColumns()
Dim wb As Workbook
Dim Y As Workbook
Dim N As Long
Dim LastRow As Long
Dim CopyRng As range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
' you need to specify the sheet, otherwise it will take the Active Sheet
With wb.Sheets("Sheet1") ' <-- modify to your sheet's name
N = .Cells(.Rows.Count, "A").End(xlUp).Row ' <-- get last row from Column "A", skips blank cells in te middle
' set the range to Columns A, F, K, AA
Set CopyRng = Application.Union(.Range("A2:A" & N), .Range("F2:F" & N), .Range("K2:K" & N), .Range("AA2:AA" & N))
End With
Set Y = Workbooks.Open("C:\Desktop\Destination.xlsx")
With Y.Sheets("Data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 '<-- get first empty row at Column A to paste at
CopyRng.Copy
.Range("A" & LastRow).PasteSpecial xlPasteValues
End With
Y.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

Resources