I'm trying to create a simple macro for a sheet I use every day at work.
Basically it's about:
Sheet 1 Cell A2:A11 has values in it those values need to be copy pasted into sheet 2 to with an offset each day to the next free column.
What I've got so far is the copy paste with one offset...but I don't know how to say that the offset should happen for the next free column.
Dim rng As Range
Dim ws As Worksheet
Range("A2:A11").Select
Selection.Copy
Sheets("Sheet2").Select
If rng Is Nothing Then
'if nothing found - search for last non empty column
Set rng = ws.Range("2:2").Find(What:="*", LookAt:=xlWhole, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
If rng Is Nothing Then
Set rng = rng.Offset(, 1)
ActiveSheet.Paste
End If
If I understand correctly, try just using this instead of all your current code
Range("A2:A11").Copy Sheets("Sheet2").Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)
Set rng = rng.End(xlToRight).Offset(0, 1)
You go all the way right and then one more for the next free column.
Related
I'm trying to copy data from a column in a sheet called "KPI", in cells H6:H100, to a specific row in a sheet named "table". The row depends on two variables in the KPI sheet which user selects from drop downs in C2:D2.
I have managed to get the code to find the right row each time by searching columns A then B in the "data" sheet.But when it comes to the copy paste/transpose column H from "KPI" sheet into the right row on the "table" sheet it throws up a 424 error.
I might be missing something really obvious so any help is appreciated.
Sub copy_transpose()
Dim rng_source As Range
Dim Found As Range, Firstfound As String
Dim rngSearch As Range
Dim Criteria As Variant
Set rng_source = ThisWorkbook.Sheets("KPI").Range("H6:H100")
Set rngSearch = Sheets("Table").Range("A:A")
Criteria = Sheets("KPI").Range("C2:D2").Value
Set Found = rngSearch.Find(What:=Criteria(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Found Is Nothing Then
Firstfound = Found.Address
Do
If Found.EntireRow.Range("B2").Value = Criteria(1, 2) Then Exit Do 'Match found
Set Found = rngSearch.FindNext(After:=Found)
If Found.Address = Firstfound Then Set Found = Nothing
Loop Until Found Is Nothing
End If
If Not Found Is Nothing Then
Application.Goto Found
rng_source.Copy
Sheets("Table").Range(cell.Offset(0, 1), cell.Offset(0, 7)).PasteSpecial Transpose:=True
Else
MsgBox ("Error")
End If
End Sub
I needed more coffee. I hadn't spotted that is was referencing "cell" instead of "found".
Today I learned that "cell" is not a vba function, and was actually something I had dimensioned in my older code, and was the equivalent of "found".
I'm creating a VBA application with some forms. When the data is inserted into the Table, Column A calculates a value with a formula. After that I need to copy the resulting value (like paste special, values only) into the adjacent Row
I just need to know how to select the last row everytime. I have tried with ActiveCell, Find, Range etc. but none are working
Selection.Copy
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Try this:
Selection.Copy
ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).PasteSpecial Paste:=xlPasteValues
From a programming point of view, it's much better to define variables rather than using Selection, .select, or ActiveCell, etc... This code will place the cell you are looking for into the variable r, assuming the first header row (A1) is not empty. If you don't want to make any assumptions about the first or last row, see the last answer on this page. In the code below, this would mean replacing Set r = r.End(xlDown) with Set r = sh.Range("A:A").Find("*", Range("A1"), SearchDirection:=xlPrevious)
Option Explicit
Sub test()
Dim sh As Worksheet, r As Range
Set sh = ThisWorkbook.Worksheets("Sheet1")
Set r = sh.Range("A1")
Set r = r.End(xlDown)
r.Select 'remove after code has been tested and you know it works
End Sub
If you have more questions, just ask. There's a lot of help available to help you program in the proper way here on StackOverflow.
Thanks all,
I fixed it with help of both
LastValue = Range("Table1[Opportunity no.]").End(xlDown).Value
Set ws = Worksheets("Datos")
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row
With ws
.Cells(iRow, 2).Value = LastValue
End With
I am attempting to create a macro to find values within a specified column and save their location for future use. The values to find are located on another sheet. The end goal is to be able to use the array full of locations to copy information from a few columns over onto a separate sheet.
Below is the code that creates my list....
Dim rng As Range
Dim TempSheet As Worksheet
'Copy list of Vendor IDs to be manipulated
sheets(4).Range("E4:E5000").Select
Set rng = Nothing
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeVisible)
rng.Copy
On Error GoTo 0
Set TempSheet = Sheets.Add
TempSheet.Range("A1").Select
Selection.PasteSpecial (xlValues)
'After Pasting values, change format to number format
[A:A].Select
With Selection
.NumberFormat = "general"
.Value = .Value
End With
'Remove duplicates from list
Range("A:A").RemoveDuplicates Columns:=1
Like I said....I dont even know where to start with this next portion of the coding...
You can use the find function to determine the column location; throw this into a loop of your search values:
k = .Rows(1).Find(What:=SEARCHVALUE, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Column
'may want to look at partials... verify that
'assumed searching in only row 1 for these "headers"
With your known destination, you can do use value=value such that:
wsd = sheets("destination")
wss = sheets("source")
wsd.columns(i).value = wss.columns(k).value
I am trying to select the last row of my table and use an outside border around the whole row up until the last column. Here is my Code
Cells(Application.Rows.Count, .Columns.Count).End(xlUp).BorderAround Weight:=xlMedium
Before I had
Cells(Application.Rows.Count, 1).End(xlUp).BorderAround Weight:=xlMedium
My second line of code only bordered the first cell. I need it to outside border all the cells in the row. I have tried different things like turning it into a "range" to only get an error. These are my closest attempts. I do not get an error but it does not do what I need it to do.
Thanks,
G
Find the table
Find the last row
Optionally clear any existing borders
Create a range object encompassing the last row (or whatever part you want to border).
Use the BordersAround property to draw the borders
Option Explicit
Sub BorderAroundBottom()
Dim WS As Worksheet
Dim rFirst As Range, rLast As Range, rTable As Range
'Need to know where table starts
Const ColHdr As String = "ColA"
Set WS = Worksheets("sheet2")
'Find first cell of the table
'Can hardcode this if known
With WS.Cells
Set rFirst = .Find(what:=ColHdr, after:=.Cells(.Rows.Count, 1), _
LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False)
If rFirst Is Nothing Then
MsgBox "First Column Header not found"
Exit Sub
End If
Set rLast = .Cells(.Rows.Count, rFirst.Column).End(xlUp)
Set rLast = .Cells(rLast.Row, .Columns.Count).End(xlToLeft)
Set rTable = .Range(rFirst, rLast)
End With
With rTable
.Borders.LineStyle = xlNone
.Rows(.Rows.Count).BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
End With
End Sub
The problem is that in both of your code attempts, you are only selecting one cell. Because you are using the Cells method, you are only selecting a single cell. You need to use Cells in conjunction with the Range object to get a multicellular region.
Assuming your data starts in cell A1 on Sheet1, here is working code:
Sub DrawBorder()
Dim rngBottomRowStart As Range
Dim rngBottomRowEnd As Range
Dim rngDataUpperLeftCell As Range
Set rngDataUpperLeftCell = Sheet1.Range("A1")
With rngDataUpperLeftCell
Set rngBottomRowStart = Sheet1.Cells(.End(xlDown).Row, .Column)
Set rngBottomRowEnd = Sheet1.Cells(rngBottomRowStart.Row, .End(xlToRight).Column)
End With
Sheet1.Range(rngBottomRowStart, rngBottomRowEnd).BorderAround Weight:=xlMedium
End Sub
I know this has probably already been answered but I have searched through the previous questions and cannot find an answer that works for me.
Basically I have an excel spreadsheet which can be updated daily/weekly/monthly depending on the workflow. What I need is a macro that finds the last 'used' column(Headers are in row 5), inserts a blank column directly to the right of that - (we have a totals table at the end that needs to move along) & copies the entire last used columns data into that newly created column.
It's probably quite a simple code but I've only just started using VBA and hope someone can help!! I'm hoping once I've started doing some bits and pieces I can build up my knowledge!
Thanks in advance
Emma
From here: Copy last column with data on specified row to the next blank column and here: Excel VBA- Finding the last column with data
Sub Test()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim rLastCell As Range
Dim LastCol As Integer
Set rLastCell = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
LastCol = rLastCell.Column
ws.Columns(LastCol).Copy ws.Columns(LastCol + 1)
End Sub
Lazy minimalist solution:
Sub Macro1()
Dim col As Integer
col = Range("A5").End(xlToRight).Column
Columns(col).Copy
Columns(col + 1).Insert Shift:=xlToRight
End Sub
Though this will crash if there's nothing in cell A5.