I have a bit of an issue. I have a table with 2 rows and several columns in a tab. One row contains several words and the second row contains the location of where those values should be copied.
For example :
Row 1 Sheet1!$D$1 Sheet5!$F$1 Sheet6$F$1 Sheet3!$D$1
Row 2 apple peer orange sum
So for example, I would like to copy apple to tab : sheet 1 in cell D1.
Is this possible in vba ?
Thanks!!
I will show you one simple example on how to achieve what you want. You will have to amend the code to suit your needs.
The below code is an example for Sheet1!$D$1 and Apple. I am assuming that the values are stored in "Sheet2" in Cell A1 and A2. Also I am not doing any error handling. Hope you will take care of that as well.
Sub Sample()
Dim rng As Range
Dim Sh As String, Cl As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet2")
With ws
Sh = Split(.Range("A1").Value, "!")(0)
Cl = Split(.Range("A1").Value, "!")(1)
Set rng = ThisWorkbook.Sheets(Sh).Range(Cl)
rng.Value = .Range("A2").Value
End With
End Sub
Related
I wanted to consolidates data of the same headers and no. of columns into the same one sheet. I have sheets of different countries e.g. US, UK, EU1, EU2, EU3, EU4.... and I am wondering if it is possible to combine sheet with name EU1, EU2, EU3, and EU4 into one sheet with vba coding?
PS. the number of EU changes each time there maybe 5 EU in other file or even 6 EU sheets so I would like it to be generalized to other file as well
Sub Aggregate
Dim ws as worksheet
Dim Target as worksheet
dim x as integer
dim t as range
Set target = worksheets(1)
set t = target.range(target.usedrange.rows.count,1) 'first blank cell
for x = 2 to worksheets.count
set ws = worksheets(x)
ws.usedrange.copy t
set t = target.range(target.usedrange.rows.count,1) 'first blank cell
next ws
End sub
How can I clear the column and row starting with a reference cell?
I used
For x = 1 To 20
Sheets(1).Columns(x).ClearContents
Next x
But I want to be able to clear the contents of all rows and columns starting with row A6 as a reference point. I cant use range since the data is dynamic and changes upon insertion of data. The data came from a csv
Since your question states "I want to be able to clear the contents of all rows and columns starting with row A6 as a reference point." Then here is a one liner using SpecialCells(xlLastCell)
ActiveSheet.Range("A6", ActiveCell.SpecialCells(xlLastCell)).Clear
If your range starts at A6 and is continuous with no blanks in Row 6 and no blanks in Column A, you could set the range like this:
'Create variables
Dim wb as Workbook
Dim ws as Worksheet
Dim rng as Range
'Initialize variables
set wb = ActiveWorkbook
set ws = ActiveSheet
lastrow = ws.Range("A6").End(xlDown).Row
lastcol = ws.Range("A6").End(xlToRight).Column
'Set the range
set rng = ws.Range(Cells(6,1),Cells(lastrow,lastcol))
'Clear contents
rng.ClearContents
This uses Range.Endproperty of the Range object. It's basically like clicking on A6 and hitting ctrl+right on your keyboard and then returning the range.
Note: If there are gaps in the range you won't get the correct result.
I populated an excel sheet with the locations of blank cells in my sheet using suggestions from this post. So I have a Column A filled with locations in the following format
$X$1 or $X2:$X$4.
What I am trying to do is use those row numbers from the column explain above to populate a separate column. I want to use the row numbers as a reference in what to populate for the column. So a Column B looking something like
=$B$1 or =$B$2:$B$4 (took 1 and 2-4 and used it as row number for reference call)
Both columns are referencing a different sheet so please excuse any column naming.
I'm not sure if this is going to require VBA or if I can get away with just using a formula, I expect VBA due to desired specifics. I've looked at post like this and this. But neither of these fully encompass what I'm looking for. Especially since I want it to express all the contents in a $B$2:$B$4 case.
My intuition on how to solve this problem tells me, parse the string from Column A for the 1st number then check if it's the end of the string. If it is, feed it to the reference that populates Column B, if not then find the 2nd number and go through a loop that populates the cell (would prefer to keep all the content in one cell in this case) with each value for each reverence.
i.e.
=$B2
=$B3
=$B4
My question is how do I go about this? How do I parse the string? How do I generate the loop that will go through the necessary steps? Such as using the number as a reference to pull information from a different column and feed it neatly into yet another column.
If (for example) you have an address of $X2:$X$4 then
Dim rng As Range
Set rng = yourSheetReference.Range("$X2:$X$4")
If you want to map that to the same rows but column B then
Set rng = rng.Entirerow.Columns(2)
will do that. note: it's not so clear from your question whether you're mapping X>>B or B>>X.
Once you have the range you want you can loop over it:
For Each c in rng.Cells
'do something with cell "c"
next c
Something like this should work for you:
Sub Tester()
Dim shtSrc As Worksheet, c As Range, rng As Range, c2, v, sep
Set shtSrc = ThisWorkbook.Worksheets("Sheet1") '<< source data sheet
Set c = ActiveSheet.Range("A2") '<<range addresses start here
'process addresses until ColA is empty
Do While c.Value <> ""
'translate range to (eg) Column X
Set rng = shtSrc.Range(c.Value).EntireRow.Columns(24)
sep = ""
v = ""
'build the value from the range
For Each c2 In rng.Cells
v = v & sep & c2.Value
sep = vbLf
Next c2
c.Offset(0, 1) = v '<< populate in colB
Loop
End Sub
Try this code:
Sub Test()
Dim fRng As Range ' the cell that has the formula
Set fRng = Worksheets("sheet1").Range("A1")
Dim tWS As Worksheet 'the worksheet that has the values you want to get
Set tWS = Worksheets("sheet2")
Dim r As Range
For Each r In Range(fRng.Formula).Rows
'Debug.Print r.Row ' this is the rows numbers
Debug.Print tWS.Cells(r.Row, "N").Value 'N is the column name
Next
End Sub
I am having difficulty looping through each column before looping through the next row. The number of columns is fixed (A:K) with an unknown number of rows. The goal is to find highlighted cells (no distinct color.. and I figured the best way to do this is to code "If Not No Fill") and copy that whole row to another workbook. This is what I have so far and I am stuck:
Option Explicit
Sub Approval_Flow()
Dim AppFlowWkb As Workbook, ConfigWkb As Workbook
Dim AppFlowWkst As Worksheet, ConfigWkst As Worksheet
Dim header As Range, headerend As Range
Dim row As Long, column As Long
Set AppFlowWkb = Workbooks.Open("C:\Users\clara\Documents\Templates and Scripts\Approval Flow Change Log.xlsx")
Set ConfigWkb = ThisWorkbook
Set AppFlowWkst = AppFlowWkb.Sheets("Editor")
Set ConfigWkst = ConfigWkb.Worksheets("Approval Flows")
With ConfigWkb
Set header = Range("A7").Cells
If Not header Is Nothing Then
Set headerend = header.End(xlDown).row
For row = 7 To headerend
For j = 1 To 11
'if cell is filled (If Not No Fill), copy that whole row to another workbook
End With
End Sub
I am getting an error with the Set headerend line, but I am trying to select the last row to use it in my for loop. I appreciate any help and guidance. Thanks in advance!
You should be able to adapt this to suit your workbooks, see the comments for details
Dim aCell as Range
' Use UsedRange to get the variable number of rows,
' cycle through all the cells in that range
For Each aCell In ActiveSheet.Range("A1:K" & ActiveSheet.UsedRange.Rows.Count)
' Test if fill colour is white (none)
If Not aCell.Interior.Color = RGB(255,255,255) Then
' Insert new row in target sheet (could find last row instead)
ActiveWorkbook.Sheets("ThisOtherSheet").Range("A1").EntireRow.Insert
' Paste entire row into target sheet
aCell.EntireRow.Copy Destination:=ActiveWorkbook.Sheets("ThisOtherSheet").Range("A1")
End If
Next aCell
Alternatively to find the last row, if you know the range is continuous (no blanks) then you can use End(xlDown) like you had done, and like below
For Each aCell In ActiveSheet.Range("A1:K" & ActiveSheet.Range("K1").End(xlDown))
I'd guess you don't want to copy the same row multiple times if you've already copied it. You could do this by keeping an array or string with previously copied row numbers and checking before copying again, or use Excel's unique functions to strip the list down after copying.
Hope this helps.
Aside:
You're using a With block but not taking advantage of it, you need to put a dot . before your Range objects to specify that they're in your With sheet. Like so
Dim myRange as Range
With ActiveSheet
Set myRange = .Range("A1:C10")
End With
You're mixing the types.
It looks like you just want to use the Row that the Header data ends on.
Take out the .Row there, since you're setting headerend to be a cell address, not a specific value. Then change For row = 7 To headerend to For row = 7 To headerend.Row
Or, change Dim Headerend as Range to ...as Long and just do headerEnd = header.End(xlDown).Row (don't use Set)
Could someone please help me with some VBA code.
I am trying to copy 2 ranges of cells between workbooks (both workbooks should be created beforehand as i don't want the code to create a new workbook on the fly).
Firstly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell H5 to the last row in column H with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell B2 for as many cells down in the B column
Secondly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell K5 to the last row in column K with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell D2 for as many cells down in the D column
Here is what I have so far:
Sub CopyDataBetweenBooks()
Dim iRow As Long
Dim wksFr As Worksheet
Dim wksTo As Worksheet
wksFr = "C:\booka.xls"
wksTo = "C:\bookb.xls"
Set wksFrom = Workbooks(wksFr).Worksheets("Sheet 3")
Set wksTo = Workbooks(wksTo).Worksheets("Sheet 1")
With wksFrom
For iRow = 1 To 100
.Range(.Cells(iRow, 8), .Cells(iRow, 9)).Copy wksTo.Cells(iRow, 8)
Next iRow
End With
End Sub
Assuming you have the reference to wksFrom and wksTo, here is what the code should be
wksFrom.Range(wksFrom.Range("H5"), wksFrom.Range("H5").End(xlDown)).Copy wksTo.Range("B2")
wksFrom.Range(wksFrom.Range("K5"), wksFrom.Range("K5").End(xlDown)).Copy wksTo.Range("D2")
Here's an example of how to do one of the columns:
Option Explicit
Sub CopyCells()
Dim wkbkorigin As Workbook
Dim wkbkdestination As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim lastrow As Integer
Set wkbkorigin = Workbooks.Open("booka.xlsm")
Set wkbkdestination = Workbooks.Open("bookb.xlsm")
Set originsheet = wkbkorigin.Worksheets("Sheet3")
Set destsheet = wkbkdestination.Worksheets("Sheet1")
lastrow = originsheet.Range("H5").End(xlDown).Row
originsheet.Range("H5:H" & lastrow).Copy 'I corrected the ranges, as I had the src
destsheet.Range("B2:B" & (2 + lastrow)).PasteSpecial 'and destination ranges reversed
End Sub
As you have stated in the comments, this code above will not work for ranges with spaces, so substitute in the code below for the lastrow line:
lastrow = originsheet.range("H65536").End(xlUp).Row
Now ideally, you could make this into a subroutine that took in an origin workbook name, worksheet name/number, and range, as well as a destination workbook name, worksheet name/number, and range. Then you wouldn't have to repeat some of the code.
You can use special cells like Jonsca has suggested. However, I usually just loop through the cells. I find it gives me more control over what exactly I am copying. There is a very small effect on performance. However, I feel that in the office place, making sure the data is accurate and complete is the priority. I wrote a response to a question similar to this one that can be found here:
StackOverflow - Copying Cells in VBA for Beginners
There is also a small demonstration by iDevelop on how to use special cells for the same purpose. I think that it will help you. Good luck!
Update
In response to...
good start but it doesn't copy anything after the first blank cell – trunks Jun 9 '11 at 5:08
I just wanted to add that the tutorial in the link above will address the issue brought up in your comment. Instead of using the .End(xlDown) method, loop through the cells until you reach the last row, which you retrieve using .UsedRange.Rows.Count.