I have the following Problem:
I have two (dynamic) lists that are named MarketsEquities and MarketsBonds and are found on worksheets SummaryEquities and SummaryBonds, respectively.
I then have a worksheet named PnL where I want to create a list of the markets listed in the previous worksheets. These Markets should all be listed in column C and a space should be provided between the end of the equities list and the start of the bond list, wherein I shall write in column B Bonds.
This is what I've got thus far:
Sub InsertEquitiesBonds()
Dim ws As Worksheet, r1 As Range, r2 As Range
Set ws = Worksheets("PnL")
ws.Activate
Set Range("B3").Value = "Equities"
Set r1 = Worksheets("SummaryEquities").Range("MarketsEquities")
r1.Copy Range("C4")
'I want to then insert "Bonds" in Column B at the end of the listing of equities and then list all bonds in column C below that.
Set r2 = Worksheets("SummaryBonds").Range("MarketsBonds")
End Sub
Help is greatly appreciated.
I recommend to specify a worksheet for every Range() or Cells() statement like ws.Range("C4") otherwise Excel guesses which worksheet you mean.
You can determine the last used cell in a column with
ws.Cells(ws.Rows.Count, "B").End(xlUp) 'last used cell in column B
and you can use .Offset(row, column) to move rows/columns relatively from that cell.
So I suggest the following:
Public Sub InsertEquitiesBonds()
Dim ws As Worksheet
Set ws = Worksheets("PnL")
ws.Range("B3").Value = "Equities"
Worksheets("SummaryEquities").Range("MarketsEquities").Copy ws.Range("C4")
Dim LastUsedCell As Range
Set LastUsedCell = ws.Cells(ws.Rows.Count, "B").End(xlUp) 'last used cell in column B
LastUsedCell.Offset(2, 0).Value = "Bonds" 'move 2 cells down and write Bonds
Worksheets("SummaryBonds").Range("MarketsBonds").Copy LastUsedCell.Offset(3, 1) 'copy MarketsBonds 3 cells down and one cell right of the last used cell
End Sub
Related
so recently I have been looking into using defined ranges to copy data instead of selecting, copying and pasting cells. This way I hope to optimise the performance and the runtime of my code.
Unfortunately I have come to face a problem I wasn't able to solve on my own.
When defining a range I want to rearrange the columns in a different order.
For example:
Set my_range = Sheets("Sheet1").Range("A2:E2,G2:H2,J2:K2,M2")
Works well, as the columns I fill into the range are behind each other in the sheet. But now I have this:
Set yo_range = Sheets("Sheet2").Range("D2,AV2,L2,H2,Q2,AE2,AG2")
If I fill these ranges into a new sheet the yo_range will fill the columns I put into it but not in the order I written down. It will put it down in the order according to the original one. In this example yo_range would put the data in this order into the new sheet:
D2 | H2 | L2 | Q2 | AE2 | AG2 | AV2
How can I fix this? I want the order to be another one than the original one.
Also - as you can see my_range has more columns than yo_range. How can I let yo_range be filled into the new sheet but at certain points leave columns out? For example:
my_range(A2:E2) goes into A2:E2 in the new sheet
yo_range(D2,AV2) goes into A:B in the new sheet, then leave C out and then paste yo_range(L2,H2) into D:E in the new sheet
I hope that I was able to explain my problem well and that there is somebody able and willing to help me. Any help is appreciated.
Edit:
Here's the code that puts the values from the ranges into the new sheet
Do
If Application.WorksheetFunction.CountA(my_range) > 0 Then
my_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
Set my_range = my_range.Offset(1, 0)
Else
Exit Do
End If
Loop
Do
If Application.WorksheetFunction.CountA(yo_range) > 0 Then
yo_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
Set yo_range = yo_range.Offset(1, 0)
Else
Exit Do
End If
Loop
We can see that the Copy method will re-arrange the data left-to-right. Try this:
Option Explicit
Public Sub CheckClipboard()
Dim ws As Worksheet
Dim rngToCopy As Range
Dim objData As Object
Dim varContents As Variant
' test data b,c,d,e,f,g in Sheet1!B1:G1
Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Range("B1:G1").Value = Array("b", "c", "d", "e", "f", "g")
Set rngToCopy = ws.Range("E1:F1,G1,B1:C1") '<-- note not left-to-right order
rngToCopy.Copy '<-- copy
' this is a late bound MSForms.DataObject
Set objData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
' copy current cell formula to clipboard
objData.GetFromClipboard
varContents = objData.GetText
Debug.Print varContents '<-- re-arranged left-to-right
' cancel copy
Application.CutCopyMode = False
End Sub
I get this in the immediate window:
b c d e f g
So, using Copy is not going to work for what you want to do.
In order to 'paste' the data in the order that you set it in the Range, you need to iterate each Area of the Range and then each cell (i.e. Range) in each Area. See the test code below which replicates your issue and presents a solution:
Option Explicit
Sub MixColumns()
Dim ws As Worksheet
Dim rngIn As Range
Dim rngOut As Range
Dim lng As Long
Dim rngArea As Range
Dim rngCell As Range
Set ws = ThisWorkbook.Worksheets("Sheet1")
' example 1
Set rngIn = ws.Range("B1:C1,E1:F1,G1") '<-- 5 cells, non-contiguous, forward order
Set rngOut = ws.Range("B2:F2") '<-- 5 contiguous cells
rngIn.Copy rngOut '<-- works
' example 2 - OP problem
Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
Set rngOut = ws.Range("B3:F3") '<-- 5 contiguous cells
rngIn.Copy rngOut '<-- should be e,f,g,b,c but gets b,c,e,f,g
' example 3 - solution for OP problem
Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
Set rngOut = ws.Range("B4:F4") '<-- 5 contiguous cells
lng = 1 '<-- rngOut cell counter
' iterate areas
For Each rngArea In rngIn.Areas
' iterate cells in area
For Each rngCell In rngArea.Cells
rngOut.Cells(1, lng).Value = rngCell.Value '<-- copy single value
lng = lng + 1 '<-- increment rngOut counter
Next rngCell
Next rngArea '<-- results in e,f,g,b,c
End Sub
Give this output:
I have a somewhat simple macro that I have made but I am rusty as I have not coded in a few years. As simply as I can put it, I Have two different Workbooks. If the workbook I have open has a certain value (or no value), I want it to fill the other workbook("Test Template") with either "proposal or pre-proposal."
That has all been easy for me. But since the worksheet adds rows as we input data, I need it to fill those values in the next available row.
I will attach code but don't worry about the proposal stuff, I just need the range changed from a specific cell into the next available cell in the column. (if d28 is full, put in d29).
Public Sub foo()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = ActiveWorkbook
Set y = Workbooks.Open("C:\Users\hmaggio\Desktop\Test Template.xlsx")
'copy Names from x(active):
x.Sheets("Sheet1").Range("C4").Copy
'paste to y worksheet(template):
y.Sheets("Sheet1").Range("B28").PasteSpecial
If x.Sheets("Sheet1").Range("C15") = "" Then
y.Sheets("Sheet1").Range("D28").Value = "proposal"
Else
y.Sheets("Sheet1").Range("D28").Value = "preproposal"
End If
First, you need a variable where you'll store the last used row number:
dim lngRows as long
lngRows = Cells(Rows.Count, "D").End(xlUp).Row
Then replace your lines of code where you have .Range("B28") with either .Cells(lngRows+1,2) or .Range("B"&lngRows)
The object Range offers a method called End that returns the last range on a certain direction.
Range("A1").End(xlDown) '<-- returns the last non-empty range going down from cell A1
Range("A1").End(xlUp) '<-- same, but going up
Range("A1").End(xlToRight) '<-- same, but going right
Range("A2").End(xlToLeft) '<-- same, but going left
In your case, hence, you can detect and use the last row of column B like this:
nextRow = y.Sheets("Sheet1").Range("B3").End(xlDown).Row + 1
More details:
The first Range of your column B is the header Range("B3")
You get the last filled range going down with .End(xlDown)
Specifically, you get the Row of that range
You add + 1 (cause you want the next available row
You store the row in the variable nextRow
... that you can then use like this:
y.Sheets("Sheet1").Range("B" & nextRow ).PasteSpecial
Try this
Public Sub foo()
Dim x As Workbook
Dim y As Workbook
Dim fromWs As Worksheet
Dim toWs As Worksheet
Dim Target As Range
'## Open both workbooks first:
Set x = ActiveWorkbook
Set y = Workbooks.Open("C:\Users\hmaggio\Desktop\Test Template.xlsx")
Set fromWs = x.Sheets("Sheet1")
Set toWs = y.Sheets("Sheet1")
With fromWs
Set Target = toWs.Range("b" & Rows.Count).End(xlUp)(2) '<~~next row Column B cell
Target = .Range("c4") 'Column B
If .Range("c15") = "" Then
Target.Offset(, 2) = "proposal" 'Column D
Else
Target.Offset(, 2) = "preproposal"
End If
End With
End Sub
I have 10 columns in a worksheet with every worksheet having a specified ID defined in the namebox. How can I store the ID's in an Array using VBA.
p.s. I do not want to store the column headings. I want to store their ID's Which are defined in the namebox for every column.
Loop through the workbook's named ranges; check that each name refers to a range on that worksheet and that the named range refers to a range that is at least partially in the first row.
Dim n As Long, vColNames As Variant
Dim c As Long, twb As Workbook
Set twb = ThisWorkbook
With Worksheets("Sheet1")
With .Cells(1, 1).CurrentRegion
'dim the array one-based to parallel the columns
ReDim vColNames(1 To .Columns.Count)
'loop through all names looking for ones that intersect first row
For n = 1 To twb.Names.Count
'check the parent worksheet first
If twb.Names(n).RefersToRange.Parent.Name = .Parent.Name Then
' next check to ensure first row is part of named range
If Not Intersect(twb.Names(n).RefersToRange, .Rows(1), .Cells) Is Nothing Then
vColNames(Intersect(twb.Names(n).RefersToRange, .Rows(1)).Cells(1, 1).Column) = _
twb.Names(n).Name
End If
End If
Next n
End With
End With
For c = LBound(vColNames) To UBound(vColNames)
Debug.Print vColNames(c)
Next c
Names with workbook scope will come out as myNamedRange; those with worksheet scope will be in the form of Sheet1!myNamedRange.
I would like to create a macro within a workbook that can be used as a comparison tool.
Historical data will be added to Worksheet 1 'Historical'. Then current data will be added to Worksheet 2 'New'. The data is in exactly the same format.
The macro should look down column G in worksheet 1 (which is a key identifier) and also column O (which shows a status). Then this data should be compared to column G and O in worksheet 2.
If column G is a match but column O has changed then the entire row, from Worksheet 2 'New', should be pasted into Worksheet 3 'Results'.
Example;
Worksheet 1 'Historical' - Column G, 123456789 and Column O, Not Valid
Worksheet 2 'New' - Column G, 123456789 and Column O, Valid
As there is a match in column G but the status has changed, the row from Worksheet 2 will be pasted into the next free row in Worksheet 3 'Results'
Any help would be greatly appreciated. I have played around with adding Vlookup and Countif into the macro without much success.
This may give you an idea, hope it's helpful.
Sub matchMe()
Dim wS As Worksheet, wT As Worksheet
Dim r1 As Range, r2 As Range
Dim cel1 As Range, cel2 As Range
Set wS = ThisWorkbook.Worksheets("Sheet1")
Set wT = ThisWorkbook.Worksheets("Sheet2")
With wS
Set r1 = .Range("G1", .Cells(.Rows.Count, .Columns("G:G").Column).End(xlUp))
End With
With wT
Set r2 = .Range("G1", .Cells(.Rows.Count, .Columns("G:G").Column).End(xlUp))
End With
On Error Resume Next
For Each cel1 In r1
With Application
Set cel2 = .Index(r2, .Match(cel1.Value, r2, 0)) 'find match in sheet2
If Err = 0 Then
If cel1.Offset(, 8) <> cel2.Offset(, 8) Then copyRow cel2 'if difference, copy
End If
Err.Clear
End With
Next cel1
End Sub
Sub copyRow(cel As Range)
Dim w As Worksheet, r As Range
Set w = ThisWorkbook.Worksheets("Sheet3")
Set r = w.Cells(w.Rows.Count, Columns("G:G").Column).End(xlUp).Offset(1) 'next row
cel.EntireRow.Copy w.Cells(r.Row, 1)
End Sub
I want to find all the cells in Column L with a particular value and return the values in Column D of the same row as those cells found.
So far, I am only able to return one result, which would be the top most result in my list, but I want to find all the rest as well, which I don't know the code to use.
Just to further explain: Value in cell D11 is the value I want to find in Column L of sheet "Master List". Supposedly I find the value in cells L13, L15 and L20, I want to return the value in cell D13, D15 and D20 into cells "C37:C39" of ws. Note: no. of cells that have the value may vary so the values returned will just appear from C37 downwards (something like automatic multiple selection, copy and paste)
Here's a little something to start the ball rolling:
Sub FindRelatedProducts()
Dim cell As Excel.Range
Dim D11Value As Variant
Dim D11Row As Variant
Dim ws As Worksheet: Set ws = Sheets("RShip")
Set cell = ws.Range("D11")
D11Value = cell.Value
With Sheets("Master List")
D11Row = Application.Match(D11Value, .Range("L:L"), 0)
If Not IsError(D11Row) Then
ws.Range("C37") = .Range("D" & D11Row).Value
End If
End With
End Sub
Here's an example using range variables.
You'll want to define a range for the input data range and a range for the output data. Then in the VBA you will want to change the wrk, inRng and outRng variables to be the named ranges you defined and change the column indexes in the for and if blocks to match the column index of the data you are looking for.
Option Explicit
Option Base 1
Sub FindValues()
Dim wrk As Worksheet
Dim inRng As Range
Dim outRng As Range
Dim cntr As Long
Dim outCntr As Long
Dim findVal As Double
Set wrk = Worksheets("Data")
Set inRng = wrk.Range("LookupRange")
Set outRng = wrk.Range("OutputRange")
' Clear the output range in case you have fewer values on this run than on the previous one
outRng.ClearContents
' Set the value you are looking for
findVal = 1
' Iterate through the rows in the input range. If you find the result you want then write it to the output range
For cntr = 1 To inRng.Rows.Count
If inRng(cntr, 1) = findVal Then ' Assumes the value you are finding is in column 1 of the input range
outRng(outCntr, 1) = inRng(cntr, 2) ' Assumes the values you are exporting is in column 2 of the input range
outCntr = outCntr + 1
End If
Next cntr
End Sub