I have a VBA function that creates a 2D array res. I'd like to write the array data to another worksheet, not the current worksheet the function is executed from. This should be pretty straightforwards but i'm new to VBA.
The code ends on the last line without an error message or writing any data.
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Output")
Dim out As Range
Set out = ws.Range("A1")
out.Resize(UBound(res, 1), UBound(res, 2)).Value = res
Your existing code should work.
Does Res actually contain data?
Sample below that populates an array, checks if it is more than one cell, then dumps back to the worksheet.
Dim wb As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Dim res
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Input")
Set ws1 = wb.Worksheets("Output")
Set rng1 = ws.Range("A1:B10")
If rng1.Cells.Count > 1 Then
res = rng1.Value2
ws1.[a1].Resize(UBound(res, 1), UBound(res, 2)).Value2 = res
End If
Related
i need a macro to select some objects (rows) of the big database with over 500 rows and copy 12 of the 44 columns into an array and reorder them into an comparison table. I need the column headers reordered as row headers.
The goal is to export the new ordered comparison table into an existing powerpoint template. I will try to not copy the entire columns and just to copy the columns i need.
I'm new to Vba and would appreciate any help.
This is my code for reading the data so far:
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Myarray As Variant
Dim LastRow As Integer, LastColumn As Integer
Dim StartCells As Range
Set ws1 = ThisWorkbook.Sheets("Sheet1") Google Set ws2 = ThisWorkbook.Sheets("Sheet2")
Set StartCell = ws1.Range("A1")
LastRow = ws1.Cells(ws1.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = ws1.Cells(StartCell.Row,ws1.Columns.Count).End(xlToLeft).Column
My fake dataset is like this:
You said I need the column headers reordered as row headers. so you need to transpose.
In my code I'm using columns 2,5,6 and 8 but you can change this easily.
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Myarray() As Variant
Dim LastRow As Integer, LastColumn As Integer
Dim StartCell As Range
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim i As Long
Dim j As Long
Set StartCell = ws1.Range("A1")
LastRow = ws1.Cells(ws1.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = ws1.Cells(StartCell.Row, ws1.Columns.Count).End(xlToLeft).Column
'copy specific columns into worksheet 2
j = 1
For i = 1 To LastColumn Step 1
Select Case i
Case 2, 5, 6, 8 'target columns to copy
With ws1
Myarray() = .Range(.Cells(1, i), .Cells(LastRow, i)).Value
End With
With ws2
.Range(.Cells(j, 1), .Cells(j, LastRow)) = Application.WorksheetFunction.Transpose(Myarray())
End With
j = j + 1
Case Else
End Select
Next i
Erase Myarray()
End Sub
Output I get:
I would like to create an array of type worksheet, not variant, then populate the array using the Array function and finally pass the array to the worksheet.copy function to crate a new workbook of the worksheets in the array variables.
The following code works but none of the arrays are of type worksheet and two of the example arrays are populated with the worksheet names.
Dim wbkThis As Workbook
Dim wstX As Worksheet
Dim wstY As Worksheet
Dim wstZ As Worksheet
Dim arrWSA As Variant
Dim arrWSB() As Variant
Dim arrWSC(1 To 3) As Variant
Cancel = True
Set wbkThis = ThisWorkbook
Set wstX = wbkThis.Worksheets("SheetX")
Set wstY = wbkThis.Worksheets("SheetY")
Set wstZ = wbkThis.Worksheets("SheetZ")
ReDim arrWSA(1 To 3) As Variant
ReDim arrWSB(1 To 3) As Variant
arrWSA = Array(wstX, wstY, wstZ)
arrWSB = Array(wstX.Name, wstY.Name, wstZ.Name)
arrWSC(1) = wstX.Name
arrWSC(2) = wstY.Name
arrWSC(3) = wstZ.Name
arrWSA(1).Copy
Worksheets(arrWSB()).Copy
Worksheets(arrWSC()).Copy
While you can create an array of worksheets, it won't work to copy them all at once (though you could copy them in a loop). An array of names is the way to go if you want to copy multiple sheets at once.
Sub CopySheets()
Dim shtCount As Long: shtCount = Worksheets.Count
Dim X As Long
Dim arrSheets() As Worksheet: ReDim arrSheets(1 To shtCount)
For X = LBound(arrSheets) To UBound(arrSheets)
Set arrSheets(X) = Worksheets(X)
Next X
' Worksheets(arrSheets).Copy After:=Worksheets(shtCount) 'This won't work.
For X = LBound(arrSheets) To UBound(arrSheets)
arrSheets(X).Copy After:=Worksheets(shtCount) 'this will
Next X
Dim arrShtNames() As String: ReDim arrShtNames(1 To shtCount)
For X = LBound(arrShtNames) To UBound(arrShtNames)
arrShtNames(X) = Worksheets(X).Name
Next X
Worksheets(arrShtNames).Copy After:=Worksheets(shtCount) 'this will as well
End Sub
I have an Excel sheet having 3000 columns and I need to convert this sheet in such a way that one tab will contain 254 columns only and remaining will go to the next tab. So I need a VBA code (Macro) which can perform the same.
As of now I wrote the following code only which is creating 3000 tabs with one column in each, also it is going to infinite loop as I did not put any condition there for blank column.
Sub SpliteIntoMultipleTab()
'
' createtemplates Macro
Dim WS As Worksheet
Dim SS As Worksheet
Dim TemplateName As String
Dim tempstr As String
'
Dim CurCol As String
Dim Template As String
Dim xColIndex As Integer
Dim xRowIndex As Integer
Dim WSCount As Integer
'==========================================================================
'Declarations
CurCol = 1
Template = "Sheet1"
'==========================================================================
Set SS = Worksheets(Template)
If WS Is Nothing Then
Start:
With ActiveWorkbook
Set WS = .Sheets.Add(After:=ActiveSheet)
WSCount = Sheets.Add(After:=Sheets(Worksheets.Count))
On Error Resume Next
Set WS = Worksheets("temp")
WS.Name = SS.Range("A1").Value
End With
Else
End If
SS.Activate
xIndex = Application.ActiveCell.Column
xRowIndex = Application.ActiveSheet.Cells(Rows.Count, xIndex).End(xlUp).Row
Range(Cells(1, xIndex), Cells(xRowIndex, xIndex)).Select
Selection.Copy
WS.Select
WS.Range("A1").Select
ActiveSheet.Paste
SS.Columns(1).EntireColumn.Delete
CurCol = CurCol + 1
GoTo Start
End Sub
Use integer division and modulus, so for example taking the 1000th column
1000 \ 254 = 3
1000 mod 254 = 238
gives the 3rd sheet and the 238th column.
So loop through from 1 to 3000 using \ and mod.
You code is very non-standard and I cannot get my head around it, I suggest you start from my code, this is an illustrative example of breaking a block of data into separate sheets. Copy the code into a new workbook then
Run CreateSheetAndPopulateWithBlockOfData once only to create a block of data.
Run Test to run the BreakBlockIntoChunks routine, you can experiment with the chunk size.
Option Explicit
Private Const csSHEETNAME As String = "Source"
Sub TestCreateSheetAndPopualteWithBlockOfData()
Dim wsSource As Excel.Worksheet
Set wsSource = CreateSheetAndPopulateWithBlockOfData(ThisWorkbook, csSHEETNAME, 20, 100)
End Sub
Sub Test()
Dim wsSource As Excel.Worksheet
Set wsSource = ThisWorkbook.Worksheets.Item(csSHEETNAME)
'Stop
Dim wbResults As Excel.Workbook
Set wbResults = Workbooks.Add
BreakBlockIntoChunks wsSource, 5, wbResults
End Sub
Function BreakBlockIntoChunks(ByVal wsSource As Excel.Worksheet, ByVal lColumnChunkSize As Long, ByVal wbDestinationWorkbook As Excel.Workbook)
Dim rngDataBlock As Excel.Range
Set rngDataBlock = wsSource.Cells(1, 1).CurrentRegion
Dim lSourceColumnCount As Long
lSourceColumnCount = rngDataBlock.Columns.Count
Dim lSourceRowCount As Long
lSourceRowCount = rngDataBlock.Rows.Count
Dim lColumnLoop As Long
For lColumnLoop = 1 To lSourceColumnCount
Dim lCurrentSheet As Long
lCurrentSheet = ((lColumnLoop - 1) \ lColumnChunkSize) + 1
Dim wsCurrentSheet As Excel.Worksheet
If lCurrentSheet > wbDestinationWorkbook.Worksheets.Count Then Set wsCurrentSheet = wbDestinationWorkbook.Worksheets.Add
If wsCurrentSheet Is Nothing Then Set wsCurrentSheet = wbDestinationWorkbook.Worksheets.Item(lCurrentSheet) '* runs first loop
'**ADD your sheet naming logic here perhaps
Dim lCurrentColumn As Long
lCurrentColumn = ((lColumnLoop - 1) Mod lColumnChunkSize) + 1
Dim rngSource As Excel.Range
Set rngSource = wsSource.Range(wsSource.Cells(1, lColumnLoop), wsSource.Cells(lSourceRowCount, lColumnLoop))
Dim rngDestination As Excel.Range
Set rngDestination = wsCurrentSheet.Range(wsCurrentSheet.Cells(1, lCurrentColumn), wsCurrentSheet.Cells(lSourceRowCount, lCurrentColumn))
rngDestination.Value2 = rngSource.Value2 '* <---Copies without using clipboard
Next lColumnLoop
End Function
Function CreateSheetAndPopulateWithBlockOfData(ByVal wb As Excel.Workbook, ByVal sSheetName As String, ByVal lRowsDeep As Long, ByVal lColumnsWide As Long) As Excel.Worksheet
Dim ws As Excel.Worksheet
Set ws = wb.Worksheets.Add
ws.Name = sSheetName
Dim rngBlock As Excel.Range
Set rngBlock = ws.Range(ws.Cells(1, 1), ws.Cells(lRowsDeep, lColumnsWide))
rngBlock.Formula = "=RANDBETWEEN(1,100000)"
rngBlock.Value2 = rngBlock.Value2
Set CreateSheetAndPopulateWithBlockOfData = ws
End Function
you could try this:
Sub SpliteIntoMultipleTab()
Dim colNum As Long, iCol As Long
With Worksheets("Sheet1").UsedRange
colNum = .Columns.count
Do
Worksheets.Add(After:=Worksheets(Worksheets.count)).Range("A1:IT1").Resize(.Rows.count).Value = .Columns(iCol + 1).Resize(, 254).Value
iCol = iCol + 254
colNum = colNum - 254
Loop While colNum > 0
End With
End Sub
which copies values only and speed up things considerably
Can anybody help me edit? I want to copy from column to another workbook column using array.
The range inside the array is the Alphabet of the column i want to copy/paste.
Sub setting2()
Dim wb As ThisWorkbook
Dim here As Workbook
Dim there As Workbook
Dim source() As Variant
Dim log() As Variant
Dim LastRowHere() As Integer
Dim LastRowThere() As Integer
'Open both workbooks first:
Set here = Workbooks.Open("C:\Users\jesslynn\Desktop\macro\Setting2.xlsm")
Set there =Workbooks.Open("C:\Users\jesslynn\Desktop\macro\Setting3.xlsm")
Windows("Setting.xlsm").Activate
source() = Array(Sheets("Sheet1").Range("E11"), Range("E12"), Range("E13"), Range("E14"), Range("E15"), Range("E16"),Range("E17").Value)
Windows("Setting.xlsm").Activate
log() = Array(Sheets("Sheet1").Range("J11"), Range("J12"),Range("J13"),Range("J14"), Range("J15"), Range("J16"), Range("J17").Value)
Windows("Setting2.xlsm").Activate
LastRowHere() = Array(Sheets("Sheet1").Rows.Count, source().End(xlUp).Row)
Windows("Setting3.xlsm").Activate
LastRowThere() = Array(Sheets("Sheet1").Rows.Count, log()).End(xlUp).Row
For i = 1 To LastRowHere()
LastRowThere(1) = there.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count.log(1)).End(xlUp).Row
For k = 1 To LastRowThere()
'here.Sheets("Sheet1").Cells(i, k).Copy Destination:=there.Sheets("Sheet1").Cells(i, k)
here.Sheets("Sheet1").Rows(i).Columns(source(1)).Copy Destination:=there.Sheets("Sheet1").Rows(k + 1).Columns(log(1))
Next k
Next i
End Sub
Your problem is source().End(xlUp).Row. You're trying to use it as a range - which it's not. That is giving you the error.
You'd be better to populate your array by using a loop. And, unless you really want to carry the cell formatting across to the destination sheet, better not to use Copy since then you don't have to activate the destination sheet.
Not sure if the code below exactly fits your need. I wasn't sure of the purpose of log() array so I've left it out. The below copies the values of a single column from Source sheet to Destination sheet.
'Open both workbooks first:
Set here = Workbooks.Open("C:\Users\jesslynn\Desktop\macro\Setting2.xlsm")
Set there =Workbooks.Open("C:\Users\jesslynn\Desktop\macro\Setting3.xlsm")
SourceCol = 5 'Column E from your example
Set SourceSht = here.Sheets(1)
Set DestnSht = there.Sheets(1)
With SourceSht
'Get last cell in the column
LastRow = .Cells(.Rows.Count, SourceCol).End(xlUp).row
End With
With DestnSht
'Get last cell in the column
DestnLastRow = .Cells(.Rows.Count, SourceCol).End(xlUp).row
End With
'Loop through all cells (assumes row 1 is header)
For r = 2 to LastRow
'Assign value from Source to Destination sheet
i = i + 1
DestnSht.Cells(DestnLastRow + i, SourceCol) = SourceSht.Cells(r, SourceCol)
Next
Try this.
I assume you need copy the value from range E11 to E17 and J11 to J17
Option Explicit
Dim CurrentWorkbook As Workbook
Dim SourceWorkbook As Workbook
Dim DestWorkbook As Workbook
Dim CurrentWorksheet As Worksheet
Dim SourceWorksheet As Worksheet
Dim DestWorksheet As Worksheet
Sub setting2()
Dim SourceLastRow As Long
Dim DestLastRow As Long
Set CurrentWorkbook = ActiveWorkbook
Set CurrentWorksheet = CurrentWorkbook.ActiveSheet
Set SourceWorkbook = Workbooks.Open("C:\Users\lengkgan\Desktop\Testing\MyData1.xlsx") 'change to your path
Set DestWorkbook = Workbooks.Open("C:\Users\lengkgan\Desktop\Testing\MyTemplate.xlsx") 'change to your path
Set SourceWorksheet = SourceWorkbook.Sheets(1)
Set DestWorksheet = DestWorkbook.Sheets(1)
SourceLastRow = SourceWorksheet.Cells(Rows.Count, "E").End(xlUp).Row
DestLastRow = DestWorksheet.Cells(Rows.Count, "J").End(xlUp).Row + 1
SourceWorksheet.Range("E11:E17").Copy Destination:=DestWorksheet.Range("E" & DestLastRow + 1) 'Change to the column you want
SourceWorksheet.Range("J11:J17").Copy Destination:=DestWorksheet.Range("J" & DestLastRow + 1) 'Change to the column you want
End Sub
As per documentation, I can define array of worksheets like below
Dim sheetsArray As Sheets
Set sheetsArray = ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2"))
But what happens if my worksheets are dynamically created and pointed by pointer variable like below? How can I make an array of them so that I can loop through them to do same activity?
Dim tempsheet1 As Worksheet
Dim tempsheet2 As Worksheet
Set tempsheet1 = Sheets.Add
Set tempsheet2 = Sheets.Add
Dim sheetsArray As Sheets
Set sheetsArray = ActiveWorkbook.Sheets(Array(tempsheet1, tempsheet2)) ' Doesn't work
For Each msheets In sheetsArray
With msheets
DO SOMETHING
End With
Next msheets
Since you should specify sheet names in Array, change
Set sheetsArray = ActiveWorkbook.Sheets(Array(tempsheet1, tempsheet2))
to
Set sheetsArray = ActiveWorkbook.Sheets(Array(tempsheet1.Name, tempsheet2.Name))