I have this issue with taking named range in Worksheet "Team overview" (which is setup to table named "tbl", column no. 2), and then pasting it transposed into another named range in another worksheet called "Knowledge matrix" (could be solved by directing it to absolute reference, but in case I change number of columns in tables/worksheet I would need to update code in VBA).
I've tried using loop through array and only switching the x,y, coordinates, but the struggle I have is with copying that selection to another named range and assigning the source named range to variable rng (which returns run-time error 5 - Invalid procedure).
The code worked for testing file without named ranges and tables with just absolute references.
Sub Transpose()
Dim rng As Range
Dim rngT As Range
Dim oarray As Variant
Dim cl As Long
Dim rw As Long
Set rng = ThisWorkbook.Sheets("Team overview").Range("Name")
Set rngT = ThisWorkbook.Sheets("Knowledge Matrix").Range("Target")
oarray = rng
For cl = 1 To UBound(oarray)
For rw = 1 To UBound(oarray, 2)
Cells(rw, cl) = oarray(cl, rw)
Next
Next
End Sub
The whole picture:
Table "tbl" is for a clear overview of team members. When the team lead adds/deletes one, I need it to be updated in all other table headers. Since headers cannot have formulas in them, I was thinking of copying the column in transposed way into named range for the other table headers.
There is also slight complication of condition the member being "Active" or "Butterfly", but that will be just cherry on the top.
So basically:
If column 1 has "Active" or "Butterfly" copy table/named range (Vertically spaced)
Transpose that array and paste it into another named array (Horizontally spaced)
I would prefer not to use .Select if possible.
Source table with named range
Target table with named range
There is already a method called Transpose.
Sub MyTranspose()
Dim rng As Range
Dim rngT As Range
Dim oarray As Variant
Set rng = ThisWorkbook.Sheets("Team overview").Range("Name")
Set rngT = ThisWorkbook.Sheets("Knowledge Matrix").Range("Target")
oarray = rng.value2
rngT.resize(ubound(oarray, 2), ubound(oarray, 1)) = _
application.transpose(oarray)
End Sub
Related
I am trying to cycle through multiple sheets in a work book and replace the formulas with values.
I would like to retain any formatting in the cells though (e.g. when I run this, it will not only change 3% to .03, but preserve any formatting)
Thank you!
Below is my code:
Sub copypastfa()
Dim count As Integer
For count = 1 To 9
Dim rng As Range
Set rng = Worksheets(1).Range("A1:Z101")
ActiveSheet.Range("A1").Resize(rng.Rows.count, rng.Columns.count).Cells.Value = rng.Cells.Value
Worksheets(ActiveSheet.Index + 1).Select
Next count
End Sub
Two unconvential approaches (other than copying)
As you found out yourself, assigning (datafield) arrays to target ranges transport only values.
[0) The conventional way]
A familiar way to solve the asked requirement to include all formats would consist in subsequent copying/pasting formats as well as values as follows:
Sub TheConventionalWay()
'0) get worksheets collection
Dim w As Sheets ' use the wider declaration type here and
Set w = ThisWorkbook.Worksheets ' assign only worksheets to the sheets collection
'1) define source range
Dim rng As Range
Set rng = w(1).Range("A1:Z101")
'2) Copy-Paste
rng.Copy
Dim i As Long
For i = 1 to 9
With Worksheets(i).Range(rng.Address)
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteValues
Next
End Sub
... but I would also like to demonstrate two not so well-known quick approaches here:
Approach 1) via xlRangeValueXMLSpreadsheet
This approach allows to get the complete spreadsheet info in an XML string which can be reassigned to the size identical target ranges. Furthermore it needs no double-assignements.
Sub XMLSpreadsheetApproach()
'0) get worksheets collection
Dim w As Sheets ' use the wider declaration type here and
Set w = ThisWorkbook.Worksheets ' assign only worksheets to the sheets collection
'1) define source range
Dim rng As Range
Set rng = w(1).Range("A1:Z101")
rng.Value2 = rng.Value2 ' change formulae to values
'2) Get Value(xlRangeValueXMLSpreadsheet), aka Value(11)
Dim Val11 as string: Val11 = rng.Value(11)
'3) Pass full XML Spreadsheet info to following worksheets
Dim i As Long
For i = 2 to 9 ' suffices to start at 2
Worksheets(i).Range(rng.Address).Value(11) = Val11 ' xlRangeValueXMLSpreadsheet = 11
Next
End Sub
Syntax
Range.Value (RangeValueDataType)
where RangeValueDataType xlRangeValueXMLSpreadsheet - equalling 11 - returns the values, formatting, formulas, and names of the specified Range object in the XML Spreadsheet format.
Approach 2) via FillAcrossSheets method
The widely unknown FillAcrossSheets method copies a range to the same area on all other worksheets in a collection.
Syntax
.FillAcrossSheets (Range, Type)
where Type (i.e. the XlFillWith enumeration) distinguishes between
-4104 .. xlFillWithAll copies contents and formats.
2 ........... xlFillWithContents copies contents only.
-4122 .. xlFillWithFormats copies formats only.
Sub FillAcrossSheetsApproach()
'0) get worksheets collection
Dim w As Sheets ' use the wider declaration type here and
Set w = ThisWorkbook.Worksheets ' assign only worksheets to the sheets collection
'1) define source range
Dim rng As Range
Set rng = w(1).Range("A1:Z101")
rng.Value2 = rng.Value2 ' change formulae to values
'2) apply to ALL sheets
w.FillAcrossSheets rng, xlFillWithAll
End Sub
If, however you want to include only a series of sheets, include the help function GetWNames() below and replace section 2) by:
'2a) apply ONLY to sheets 1 to 9 ' source sheet has to be included!
ThisWorkbook.Sheets(GetWNames(w,1,9)).FillAcrossSheets rng, xlFillWithAll
Function GetWNames(w As Sheets, first As Long, last As Long)
Dim tmp() As String: ReDim tmp(first To last)
Dim i As Long
For i = first To last
tmp(i) = w(i).Name
Next i
GetWNames = tmp ' return Array(w(1).Name, .. w(last).Name)
'Debug.Print Join(GetWNames, "|")
End Function
Further link
In an older post I demonstrated how to write an array as identical information to all sheets using this method.
I'm currently trying to copy a filtered column to an array to populate a ComboBox in a Powerpoint presentation.
The line of code I'm using to do this is:
ar = tbl.ListColumns(ColNumber).Range.SpecialCells(12).Value
Where "ar" is the destination array, "tbl" is the source table and "ColNumber" is the number of column I'm trying to copy.
The filtered column I'm trying to copy has around 180 records but I noticed the destination array has 6 values since it selected only until the first "hidden" row in the range, and skipped every other visible row after that.
Is there a way to get the value of every visible row and not just the first ones?
You are facing that issue because of Non Contigous range. You cannot use the method Array = Range.Value for Non Contigous range. There are two ways you can follow to achieve what you want.
WAY 1 Identify the Range, Loop through the cells and populate the array. Suitable for your case as you are dealing with single column.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim tbl As ListObject
Dim ar As Variant
Dim i As Long, n As Long, ColNumber As Long
Dim aCell As Range, rng As Range
'~~> Change this to the relevant sheet
Set ws = Sheet1
'~~> Change this to the relevant table
Set tbl = ws.ListObjects("Table1")
ws.AutoFilterMode = False
'~~> Change to relevant column number
ColNumber = 1
'~~> Autofilter as required
tbl.Range.AutoFilter Field:=ColNumber, Criteria1:="Blah1"
'~~> Set your range
Set rng = tbl.ListColumns(ColNumber).Range.SpecialCells(12)
'~~> Get the count of cells in that range
n = rng.Cells.Count
'~~> Resize the array to hold the data
ReDim ar(1 To n)
n = 1
'~~> Store the values from that range into the array
For Each aCell In rng.Cells
ar(n) = aCell.Value
n = n + 1
Next aCell
For i = LBound(ar) To UBound(ar)
Debug.Print ar(i)
Next i
End Sub
WAY 2 Identify the Range, loop thorough the Area and then loop through the cells in that Area and then populate the array. Very similar to the above code.
In Action
This code was working just fine, but I did a bunch of other code that manipulates and reads the same area of the sheet and now this section does not work.
I have tried a bunch of stuff with syntax but none worked. It may be that I need to resize my array but since im setting it equal to a range I didnt think that I had to. Also It says the problem is the range but I dont know. I would rather not have to resize as its taking from a larger table whose line items will be dynamic but I can do that and make it dynamic if I need to. I did try deleting the range and renaming it and it did not work.
Private Sub UserForm_Initialize()
Dim codes()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
codes = ws.Range("cCodes")
CostCode1.List = codes ''these are combo boxes
CostCode2.List = codes
CostCode3.List = codes
CostCode4.List = codes
CostCode5.List = codes
CostCode6.List = codes
'' ADD UNITS
End Sub
you don't need to declare the sheet for the named range.
named ranges are stored as an external address including the sheet's Name.
codes = Range("cCodes")
should be sufficient.
As far as I can tell the error comes because you don't have the named range "cCodes").
Go to Formulas -> Name Manager and check your names. Alternatively, use a range directly in the code, i.e.: codes = ws.Range("A1:A100")
To answer your question in the comment:
Is there a way for me to directly reference the three columns of the table that I want to set to the array
Here are a few ways to manipulate the range from your table into the array (specific rows/columns), and back on the sheet (see comments in code). Hope this helps.
Option Explicit
Sub test()
Dim rngData As Range
Dim arrData As Variant
With Range("Table1") 'this is only the content of the table, does not include the headers
Set rngData = Range(.Cells(1, 1), .Cells(.Rows.Count, 3)) 'Set the range starting at cell row 1, col 1 - until total number of rows in table, col 3
'Set rngData = rngData.Offset(-1).Resize(.Rows.Count + 1) 'if you want to include headers as well
Debug.Print rngData.Address
End With
arrData = rngData 'allocate the data from the range to the array
rngData.Offset(0, Range("Table1").Columns.Count + 1) = arrData 'put the array back on the sheet, 1 column to the right of the table
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Range("N1").Resize(UBound(arrData), UBound(arrData, 2)) = arrData 'put the array back on the sheet in a specific range
End Sub
I've tried various ways and answers to select all of the rows except the header for a certain column and none seem to work.
I've tried using (15 is the column here):
Range(Cells(2, 15), Cells(.Cells(rows.Count, 15).End(xlUp).Row, 15)).Select
I managed to use .Activate on the worksheet with a different statement to select all, but this changes the sheet and you could visibly see all the rows being selected. This isn't possible for what I need it for. Users can't have a bunch of sheets constantly being switched in front of them, makes for a bad experience.
How can I select all of the non-blank columns after the header (first) row without using .Activate?
I need to get these values, put them in an array, and check if the current cell value is in the array. Not asking for this part, but providing it as context if it matters.
You can not select a range on a non-active worksheet.
Here is how you can set a reference to all the cells in a column except the header row.
Dim TargetRange As Range
With Worksheets("Sheet1")
Set TargetRange = .Range(.Cells(2, 15), .Cells(Rows.Count, 15).End(xlUp))
End With
The following code reads the data from the Worksheet (without using Select or Activate), and puts it in a 2-dimensional array.
Option Explicit
Sub Range_WO_Headers()
Dim Sht_Source As Worksheet
Dim Rng As Range
Dim LastRow As Long
Dim LastCol As Long
Dim Rng_Array As Variant
' modify Sheet1 according to your sheet name
Set Sht_Source = ActiveWorkbook.Worksheets("Sheet1")
' assuming the table's data starts from Cell A1
LastRow = Sht_Source.Cells(Sht_Source.Rows.Count, "A").End(xlUp).Row
LastCol = Sht_Source.Cells(1, Sht_Source.Columns.Count).End(xlToLeft).Column
' resize array according to number of columns and number of rows
ReDim Rng_Array(0 To LastRow, 0 To LastCol)
' set dynamic array from Cell A1 to last row and last column found (starting the second row)
Set Rng = Sht_Source.Range(Cells(2, 1), Cells(LastRow, LastCol))
Rng_Array = Application.Transpose(Rng)
End Sub
Thanks for helping me out. I couldn't find a solution to this on the web so here a am :P. I am wondering how to paste a range of values, in this case C6:R371, to another worksheet in the same size. My problem is that I only want to paste data from the source worksheet into cells that are blank on the target worksheet and not change the values that are already in the range C6:R371 on the target worksheet. Essentially, I have a range of cells that i need to c&p, but i want the macro to only paste values from the range onto the blank cells of the target range. Thank you so much
Range("C6:S371").Select
Selection.Copy
wbWest2.Activate
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("D9:S374")
For Each row In rng.Rows
For Each cell in row.Cells
If cell.value = 0 then selection.paste
Next cell
Next row
Isolate the two worksheets using With ... End With statements so thier cells are the only ones that are considered. The fastest comparison would be bulk loading the two ranges into variant arrays.
Sub fill_blanks_from_source()
Dim r As Long, c As Long, aSRCs As Variant, aDSTs As Variant
With Worksheets("Sheet1") '<~~ source
aSRCs = .Range("C6:R371").Value2
End With
With Worksheets("Sheet2") '<~~ destination
aDSTs = .Range("D9").Resize(UBound(aSRCs, 1), UBound(aSRCs, 2)).Value2
End With
For r = LBound(aDSTs, 1) To UBound(aDSTs, 1)
For c = LBound(aDSTs, 2) To UBound(aDSTs, 2)
If Not CBool(Len(aDSTs(r, c))) Then
aDSTs(r, c) = aSRCs(r, c)
End If
Next c
Next r
With Worksheets("Sheet2")
.Range("D9").Resize(UBound(aDSTs, 1), UBound(aDSTs, 2)) = aDSTs
End With
End Sub
Once the comparisons have been met and blank values from the destination filled with values from the source, the entire variant array is returned to the destination worksheet.
The ranges will always remain the same size. Once the source values are loaded to the first variant array, the LBound and UBound functions are use for all further dimensioning of the destination range expanding from the cell in the top-left corner.