Unselect column after pasting data - excel

this may be very simple but I am not able to work around it.
I could free up the column from where I am copying data by using Application.CutCopyMode=False but the column where data is pasted is still remain selected, I tried ActiveSheet.EnableSelection = xlNone as suggested in one of the forum without any success rest of my code working fine:
Dim wb As Workbook
Dim t1 As Worksheet
Dim r As Worksheet
Set wb = ActiveWorkbook
Set t1 = Sheets("dataT1")
Set r = Sheets("HPV1report")
t1.Range("D3:CR5").Copy
r.Range("A2").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True
Selection.EntireColumn.AutoFit
End sub
Other thing I can think of is selecting Cell A1 so the column will get free but I will prefer to use select if i can.

You can not really un-select a cell, because it is in the nature of a worksheet that there is always a selected cell.
The only reason why there might be no selected cell is
you select an object like a control/button, etc.
or to protect the worksheet against user interaction like #moosli pointed out.
So the correct way to go is, as you already found out:
Select any other cell, eg. A1.
Worksheets("MySheet").Range("A1").Select

You can achieve it in this way
Application.ScreenUpdating = False
Worksheets("name sheet selected data").Activate
Worksheets("name sheet selected data").Range("A1").Select
Worksheets("name sheet you want goto").Activate
Application.ScreenUpdating = True

As PEH pointed out, there is always something selected in Excel, so he proposes to select a hardcoded cell like A1. I prefer to store the cell that is active before the copy/paste process and reselect this cell after pasting.
Dim ActCell As Excel.Range
Set ActCell = Excel.Application.ActiveCell
'Do the copy and paste process
Excel.Application.CutCopyMode = Excel.XlCutCopyMode.xlCut
ActCell.Select

Related

VBA pasting information from a form onto the next open line in a table

I have the following form:
When user clicks the "Submit Adjustment" button, I want the information in the yellow boxes (plus the date on that line) entered into the following table
Here's the code I'm using:
Sub LOG_CHG()
Sheets("ENTER CHG").Range("B8:I8").Copy
Sheets("CHANGE LOG").Cells(Rows.Count, "A").End(xlUp).Offset(1). _
PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
MsgBox ("Your adjustment has been logged.")
Range("C8:I8").Select
Selection.ClearContents
Range("C8").Select
End Sub
This is happening somewhat successfully, but sometimes it gets lost and pastes at the bottom of the table or in random places.
How can I make sure it pastes the information in the next available row?
Sheets("CHANGE LOG").Cells(Rows.Count, "A").End(xlUp).Offset(1)
This line means Excel is checking sheet "change log" from last Excel line in column A up until it finds any symbol in cell. And offset(1) means 1 row down. For example:
You have something written in A32(space, number or letter), but from A33 to A1000000+ row is nothing --> so your code will paste everything in A33.
In other words Select A1000000 and press Ctrl+UP.
As you are using a table on the log-sheet you can access it via the listobjectwhich is pretty easy to program against.
Public Sub log_chg()
Dim rgSource As Range
Set rgSource = ThisWorkbook.Worksheets("Enter chg").Range("B8:I8")
Dim loChangeLog As ListObject
Set loChangeLog = ThisWorkbook.Worksheets("Change log").ListObjects(1)
Dim lrTarget As ListRow
Set lrTarget = lo.ListRows.Add
lrTarget.Range.Value = rgSource.Value
End Sub
No need to check for the last row or anything.
ListRowis always appended to the end of the table.
As the ranges of the source and the target are of same size you can write the value like shown in the code.
What you should do before testing: delete all the empty rows of the log table.

Excel 2010 - Copy data to a specified sheet based on drop-down value.

new to this forum and hoping someone can help!
I'm creating a database of resources for a project. I have created a sheet called 'Summary' to enter details of the resource (Organisation, type, location, contact details etc). The list is organised vertically and has a few drop-down data validation fields.
see summary
What I'm trying to do is attach a macro to the 'Add to database' button that will copy the data from the 'Summary' sheet to one of the other worksheets based on the value in the drop-down (cell: E4) and transpose this horizontally and then clear the field.
I've created individual Macro's to perform this (9 altogether) such as:
Sub EMPTADD()
Application.ScreenUpdating = False
Range("E2:E19").Select
Selection.Copy
Sheets("Employability & Training").Activate
Range("A750").End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Summary").Activate
Range("E2:E19").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("E2").Select
Application.ScreenUpdating = True
End Sub
I just can't work out where to go from there. Can I use an IF function to determin if E4 hold a specific value and call the relevant Macro? Any help much appreciated :)
You don't need to utilize the activate/selection type commands. VBA is capable of working much more dynamically than that. Using activate/selection type commands can also open your coding up to a number of unintended consequences. Sometimes what you think is active, and what excel thinks is active, can be two different things. It's best practice to fully qualify your ranges so there is never any doubt.
As far as coding goes, it looks like you're trying to manually replicate how you would go about clicking on specific ranges and manipulating the data (maybe basing it off of recording a macro?). We can use VBA more dynamically than that! I would use something like this:
Sub CopyPasteData()
'Declare your variables
Dim wb As Workbook
Dim criteria As String
Dim i As Long
Application.ScreenUpdating = False
'Set values for your variables.
Set wb = ThisWorkbook
criteria = wb.Sheets("Summary").Range("E4")
i = wb.Sheets(criteria).Range("A" & Rows.Count).End(xlUp).Row
'Tell excel where to copy and paste your data
wb.Sheets("Summary").Range("E1").Copy
wb.Sheets(criteria).Range("A" & i + 1).PasteSpecial xlPasteValues
wb.Sheets("Summary").Range("E2").Copy
wb.Sheets(criteria).Range("B" & i + 1).PasteSpecial xlPasteValues
wb.Sheets("Summary").Range("E3").Copy
wb.Sheets(criteria).Range("C" & i + 1).PasteSpecial xlPasteValues
wb.Sheets("Summary").Range("E4").Copy
wb.Sheets(criteria).Range("D" & i + 1).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End Sub
If you use variables to set some of your values, you'll be able to use one macro for all of your Workbooks. No If statement will be necessary! The wb variable creates a shortcut for declaring which workbook the macro should operate in. The criteria value is set to whatever you have entered into cell E4 on the SUMMARY worksheet. As long as your Worksheet names match your dropdown list in E4, this will tell excel which Worksheet to put your data in. The i variable counts the number of rows that contain data (and that way we can paste new data at the bottom of those rows).
Then the last bit of code just tells Excel where to copy data, and where to paste it. Adjust the ranges as needed to do what you need it to.

Using VBA Find function to check whether a range already exists on Excel worksheet

Very new to VBA (and coding in general), trying to teach myself with the info that I can find online.
Writing a macro that will copy over employee performance data that is entered on the MAIN sheet, row by row, over to the LOG sheet of a workbook.
Up to that point, I've managed to make it work fine. But now I want to add a FIND function to determine whether a row of data already exists on the LOG sheet, so that I can then use an IF... THEN statement:
If data for a particular employee AND date does not exist yet, then that row is copied over to first empty row of the LOG sheet.
If it does exist already, the existing row of data on the LOG sheet will be overwritten.
This is what I've got:
Sub CopyToLog()
Dim RowCount As Integer
Sheets("MAIN").Select
For RowCount = 1 To Range("WeeklyData").Rows.Count
With Sheets("LOG").Range("A:B")
Set Dupe = .Find(Sheets("MAIN").Range("B5:C5").Offset(RowCount - 1, 0), LookIn:=xlValues)
Range("B5:F5").Offset(RowCount - 1, 0).Select
Selection.Copy
Sheets("LOG").Select
If Dupe Is Nothing Then
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
Dupe.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End With
Sheets("MAIN").Select
Next RowCount
End Sub
This does not work however. It looks like the problem is in the Find function:
With Sheets("LOG").Range("A:B")
Set Dupe = .Find(Sheets("MAIN").Range("B5:C5").Offset(RowCount - 1, 0), LookIn:=xlValues)
I need to check for both Date and Employee (columns B & C on the MAIN sheet vs columns A & B on the LOG sheet), however it seems the formula as it is here is only comparing the first column (Date). As a result, data for one employee now gets overwritten by the next employee if it is for the same date.
Can you only use Find to find a single-cell value, not for a range of two neighbouring cells? If so, any tips on how to get around this?
It sounds like helper cells can accomplish what you're after. I'm assuming you have space in cell D5 next to Sheets("MAIN").Range("B5:C5"). Enter in the formula =B5&C5 into D5. Doing this will give you the combination of the two and allow you to achieve the lookup you want. You'll also need a helper column for your lookup range on your log sheet. If your information starts on row 10 in cell C10 enter =A10&B10, copy down as needed. With these in place you can now use them for your check. I altered your code to use the helper cells.
Sub CopyToLog()
Dim main As Worksheet
Set main = ThisWorkbook.Worksheet("MAIN")
Dim log As Worksheet
Set log = ThisWorkbook.Worksheets("LOG")
Dim searchRange As Range
Set searchRange = log.Range("C:C") 'Helper Column
Dim RowCount As Integer
For RowCount = 1 To main.Range("WeeklyData").Rows.Count
Dim lookFor As String
lookFor = main.Range("D5").Offset(RowCount - 1, 0).Value2 'Uses helper cells
Dim dupe As Range
Set dupe = searchRange.Find(lookFor, LookIn:=xlValues)
Dim copyInfo As Range
Set copyInfo = searchRange.Range("B5:F5").Offset(RowCount - 1, 0)
Dim destination As Range
If dupe Is Nothing Then
Set destination = log.Range("A" & Rows.Count).End(xlUp).Offset(1)
Else
Set destination = dupe
End If
destination.Resize(ColumnSize:=copyInfo.Columns.Count).Value2 = copyInfo.Value2
Next
main.Select
End Sub
Work with the objects themselves. I removed the .Select and Selection. pairs. Not using them will make your code more readable and faster. To get started the macro recorder will use them but be aware you can sandwich them out (IE Range("M10").Select followed by Selection.Copy is best written as Range("M10").Copy).
I replaced any unqualified Range variables with qualified ones. Range is implicity using the ActiveSheet, in essence it's ActiveSheet.Range. Qualifying it with a worksheet object like main.Range("A5") lets you know exactly which sheet it's coming from. This saves you from hair pulling moments later on.
destination.Resize(ColumnSize:=copyInfo.Columns.Count).Value2 = copyInfo.Value2 is doing the same as copying the values directly. Resize is used to make both ranges be the same size.

Cannot copy to the last cell in the range

I have written a code to loop though range of cells and copy certain data in a column. But everytime I run the code it just copies the last record and not all of them. The issue is somewhere in the destination line of code where it can't find the last unused cell. Any help will be very appreciated. Many Thanks.
Sub ImmoScout()
Dim MyRange As Range, Mycell As Range, Mycell2 As String
Set MyRange = Application.Selection
'Application.ScreenUpdating = False
For Each Mycell In MyRange
Mycell2 = Mycell.Value
Worksheets("Sheet1").Activate
Worksheets("Sheet1").AutoFilterMode = False
Range("A1:BB34470").AutoFilter Field:=54, Criteria1:=Mycell2
Range("AM1").Select
Range(Selection, Selection.End(xlDown)).Select
If Selection.Cells.Count < 1048576 Then
Selection.Copy Destination:=Range("BP1048576").End(xlUp).Offset(1, 0)
Range("AU1").Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Destination:=Range("BQ1048576").End(xlUp).Offset(1, 0)
End If
Next Mycell
' Application.ScreenUpdating = True
End Sub
You could use advanced filter:
Sheets("Emps").Range("A1:D8").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Emps").Range("F5:F6"), CopyToRange:=Range("A1:B1"), _
Unique:=False
Data source to selectively copy:
Data destination copied:
Reference this short YouTube video; You can record a marco to help yourself with the code also:
https://www.youtube.com/watch?v=bGUKjXmEi2E
A more thorough tutorial is found here:
http://www.contextures.com/xladvfilter01.html
This tutorial shows how to get the source data from outside Excel:
https://www.extendoffice.com/documents/excel/4189-excel-dynamic-filter-to-new-sheet.html
This tutorial shows how to split data values based on a column to different sheets (Fruit column; Apple sheet, Pear sheet, etc.):
https://www.extendoffice.com/documents/excel/2884-excel-save-filtered-data-new-sheet-workbook.html
Side note: your criteria needs the titles you are querying on just like the output needs the titles to know where to place the info. If it doesn't match correctly, Excel won't know what you mean. Don't forget to update the range name!
Before version:
After version:
Your code in this case is:
Sub yourFilter()
Range("Source").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Sheet2!Criteria"), CopyToRange:=Range("Sheet1!Extract"), Unique:=False
End Sub
Avoid using Select and Activate which is not required when Autofiltering or copying a range. Instead declare some range variable, set it properly and use it.
After you have applied autofilter, maybe you are interested in copying the visible cells. Change the lines which are copying the ranges as below...
Range("AM1:AM34470").SpecialCells(xlCellTypeVisible).Copy
Range("AU1:AU34470").SpecialCells(xlCellTypeVisible).Copy
Also Selection.End(xlDown) is not very reliable, it will stop once it finds an empty cell if any before the last cell in the column.

Vlookup from Another Workbook with fill to Last Row

I'm looking to import data from another file (combinedWorkbook) to my master file (the file which is running the code) using a vlookup. I then need it to drag the vlookup down to the bottom row of data (using column M in the masterfile as a reference to when the data ends) with cell I15 being the starting point for the vlookup in the masterfile.
The problem I'm having is that when running the macro the vlookup is happening in cell M10 in my masterfile, not dragging down the vlookup to the end of the data and not referencing the combinedWorkbook.
Any help would be appreciated.
This is what I got so far
Dim combinedBook As Workbook
Dim filter As String
Dim caption As String
Dim combinedFilename As String
Dim combinedWorkbook As Workbook
Dim targetWorkbook As Workbook
MsgBox ("Select Unpaid Capital Extract")
Set targetWorkbook = ThisWorkbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file"
combinedFilename = Application.GetOpenFilename(filter, , caption)
Set combinedWorkbook = Application.Workbooks.Open(combinedFilename)
ThisWorkbook.Activate
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-8],combinedWorbookSheet1!R1C1:R700000C2,2,0)"
Range("M16").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlUp)).Select
Range("I15:I60297").Select
Range("I60297").Activate
Selection.FillDown
Range("I15").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.End(xlUp).Select
Range("I15").Select
combinedWorkbook.Close False
There are simply too many unknowns in your code to give a specific answer.
Some observations:
1) Always use Option Explicit at the top of your code, it will pick up mistakes and inconsistencies for you.
2) Watch out for unused variables declared in your code
3) Always specify which workbook and worksheet you are working with; don't just put Range ... or Cells.... this leads to all sorts of bugs.
4) Your VLOOKUP syntax for working with another workbook needs to be of the order
'[" & combinedWorkbook.Name & "]Sheet1'
5) xlsx are not text files btw re: your filter
6) For the rest i.e. where you want formulas to go, how you are determining last row etc I am just having to guess. Be specific when coding and try bullet pointing pseudo code first so you are clear what is going on at each stage.
Option Explicit
Sub test()
Dim filter As String
Dim caption As String
Dim combinedFilename As String
Dim combinedWorkbook As Workbook
Dim targetWorkbook As Workbook
MsgBox "Select Unpaid Capital Extract"
Set targetWorkbook = ThisWorkbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file"
combinedFilename = Application.GetOpenFilename(filter, , caption)
Set combinedWorkbook = Application.Workbooks.Open(combinedFilename)
'Assuming M is used to find last row in targetWorkbook
Dim lastRow As Long
With targetWorkbook.Worksheets("Sheet1") 'this wasn't specified (specify appropriate sheet name)
lastRow = .Cells(.Rows.Count, "M").End(xlUp).Row
'Assuming I is where formula is being put
.Range("I15:I" & lastRow).FormulaR1C1 = _
"=VLOOKUP(RC[-8],'[" & combinedWorkbook.Name & "]Sheet1'!R1C1:R700000C2,2,0)"
combinedWorkbook.Close False
End With
End Sub
As I understood you need to apply a vlookup formula in your master file gathering data from another workbook.
The proper strucutre is as followed:
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[8],[Book1]Sheet1!R1C5:R23C6,2,FALSE)"
The first bold text is the place of the value you are looking for, relative to the active cell.
The second bold text is the position of your reference table in your other workbook ( here it is book 1).
You can apply this formula to your masterfile by using a loop.
Dim lastRow as Integer
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "M").End(xlUp).Row
endCount = 15 + lastRow
For i = 15 to endCount
ActiveSheet.Cells(i,13).FormulaR1C1 = "=VLOOKUP(RC[-8],[combinedWorkbook]Sheet1!R1C1:R700000C2,2,FALSE)"
next i
This will apply the vlookup formula in the column I starting row 15 searching for the value in the same row but 8 column before (column "A") and will apply for as many row as there are value in the column M.

Resources