VBA to duplicate large dataset using array - vba

I have data on sheet A and want to duplicate it on sheet B. Because it is a lot of data, I do not want to use copy-paste. If I really simplify it, this is my code. My ranges change although I made it sort of fixed in this simplified code. I do not want to use something like range("A1:BBB100000") since my range will change. I get 1004 error "Application-defined or object-defined error". What am I doing wrong?
Dim origin(1 to 100000, 1 to 100000) as Variant
Dim dest(1 to 100000, 1 to 100000) as Variant
Set A=Worksheets("A")
Set B=Worksheets("B")
Vrow=100000
set origin=A.range(cells(1,1),cells(Vrow, Vrow))
set dest=B.range(cells(1,1),cells(Vrow, Vrow))
dest=origin

You don't need the array. Only generate an array if your actually going to do any calculations on it. If you just want to do value -> value then that's what you do (as shown below).
Remember to always declare all your variables as well.
Dim A As Worksheet, B As Worksheet, Vrow As Long
Set A = Worksheets("A")
Set B = Worksheets("B")
Vrow = 100000
B.Range(B.Cells(1, 1), B.Cells(Vrow, Vrow)).Value = A.Range(A.Cells(1, 1), A.Cells(Vrow, Vrow)).Value

Copy Range Values to Another Worksheet
Sub CopyValues()
Const sName As String = "A"
Const sFirstCellAddress As String = "A1"
Const dName As String = "B"
Const dFirstCellAddress As String = "A1"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim sfCell As Range: Set sfCell = sws.Range(sFirstCellAddress)
Dim srg As Range: Set srg = sfCell.CurrentRegion
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dfCell As Range: Set dfCell = dws.Range(dFirstCellAddress)
Dim drg As Range: Set drg = dfCell.Resize(srg.Rows.Count, srg.Columns.Count)
drg.Value = srg.Value
End Sub
Sub CopyValuesShorter()
Dim srg As Range
Set srg = ThisWorkbook.Worksheets("A").Range("A1").CurrentRegion
Dim drg As Range
Set drg = ThisWorkbook.Worksheets("B").Range("A1") _
.Resize(srg.Rows.Count, srg.Columns.Count)
drg.Value = srg.Value
End Sub
Sub CopyValuesShortest()
With ThisWorkbook.Worksheets("A").Range("A1").CurrentRegion
ThisWorkbook.Worksheets("B").Range("A1") _
.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End Sub

Related

VBA: Having trouble counting and then printing the no. of rows- error 1004

In one workbook, I have sales data. I want to count the number of rows (start from row 6 as rows 1-5 are blank) and then paste this into my other workbook. They're both already open and always will be during this process.The below code is returning error 1004
Sub StoreDateAndRowCount()
Dim SalesWb As Workbook, TrackerWb As Workbook
Set SalesWb = Workbooks("Trial 30.08.2021.xlsm")
Set TrackerWb = Workbooks("Tracker.xlsm")
Dim SalesWs As Worksheet, TrackerWs As Worksheet
Set SalesWs = SalesWb.Sheets("Sales Volumes")
Set TrackerWs = TrackerWb.Sheets("Tracker ET")
Dim last_row As Long
Dim Date1 As Long
LDate = Date
'Below is where I'm getting the error
'Application- defined or Object- defined error 1004
last_row = SalesWs.Cells(Rows.Count, 6).End(xlUp).Row
TrackerWs.Range("B" & Rows.Count).End(xlUp).Offset(1).Value = last_row
TrackerWs.Range("A" & Rows.Count).End(xlUp).Offset(1).Value = LDate
End Sub
Always use fully qualified references. When you call Rows.Count it's going to pull from ActiveWorkSheet which is not going to be the same as SalesWs and TrackerWs.
You might be getting that error because the workbook you are citing isn't open.
Option Explicit
Public Sub StoreDateAndRowCount()
Dim SalesWb As Workbook
Set SalesWb = Workbooks("Trial 30.08.2021.xlsm")
Dim TrackerWb As Workbook
Set TrackerWb = Workbooks("Tracker.xlsm")
Dim SalesWs As Worksheet
Set SalesWs = SalesWb.Sheets("Sales Volumes")
Dim TrackerWs As Worksheet
Set TrackerWs = TrackerWb.Sheets("Tracker ET")
Dim LDate As Long
LDate = Date
Dim last_row As Long
last_row = SalesWs.Cells(SalesWs.Rows.Count, 6).End(xlUp).Row
TrackerWs.Range("B" & TrackerWs.Rows.Count).End(xlUp).Offset(1).Value = last_row
TrackerWs.Range("A" & TrackerWs.Rows.Count).End(xlUp).Offset(1).Value = LDate
End Sub

Set Range as Found String Location in VBA

I'm trying to set a range in VBA as the range of the inputted string that I am looking for. The full procedure is supposed to pop up a dialog box to look for a specific string, find the string, create a range called location, set this range to the range of the string that was found, move a finite amount of columns to the right, and with that new columns value, print a string into that range.
The problem right now is that for some reason It is not setting the range to the range of the string it finds.
There is only one instance of the string throughout the workbook.
I'm also relatively new to VBA so there are something commands I don't know or understand how they work.
Sub test()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim Inp As String
Dim Loc As Range
Dim Row As Integer
Dim Col As Integer
Dim NewLoc As Range
Dim Sh As Worksheet
Inp = InputBox("Scan ESD Tag")
For Each Sh In ThisWorkbook.Worksheets
With Sh.Columns("A")
Set Loc = .Find(What:=Inp)
End With
Next
Row = Loc.Row
Col = Loc.Column + (3 * 5)
Set NewLoc = Worksheets("Building 46").Cells(Row, Col)
NewLoc.Value = "Over Here"
Range("G2") = 6
End Sub
Your problem is probably that your final block should be inside the loop as otherwise Loc is likely to be Nothing (unless the term is found on the last sheet) and your code will error. You should also check first that it is found to avoid such errors.
Sub test()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim Inp As String
Dim Loc As Range
Dim Row As Integer
Dim Col As Integer
Dim NewLoc As Range
Dim Sh As Worksheet
Inp = InputBox("Scan ESD Tag")
For Each Sh In ThisWorkbook.Worksheets
With Sh.Columns("A")
Set Loc = .Find(What:=Inp)
If Not Loc Is Nothing Then
Row = Loc.Row
Col = Loc.Column + (3 * 5)
Set NewLoc = Worksheets("Building 46").Cells(Row, Col)
NewLoc.Value = "Over Here"
Range("G2") = 6 'should specify a sheet here
Exit Sub
End If
End With
Next
End Sub

Can't define workheet in VBA

Going crazy here. I use this definition of worksheet all the time. Copied every string to avoid typing errors. Still, the code below produces "Nothing" when I try to set FR worksheet. Pls help!
Sub FindReplace()
Dim FRep As Worksheet
Dim c As Range
Dim cText As TextBox
Dim i As Integer
Set FRep = ThisWorkbook.Worksheets("FindReplace")
For i = 1 To 23
cText = FRep.Cells(i, 3).Text
FRep.Cells(i, 2).NumberFormat = "#"
FRep.Cells(i, 2).Value = cText
Next i
The code as is seems correct. Make sure that "FindReplace" worksheet is in ThisWorkbook.
Also, you can try to get "FindReplace" worksheet by CodeName instead of by the name of the sheet. The advantage is that if the user changes the name of the worksheet, the CodeName will remain the same and you won't need to update your code to the new worksheet name.
Public Function GetWsFromCodeName(codeName As String, wb As Workbook) As Worksheet
Dim ws As Worksheet
For Each ws In wb.Worksheets
If ws.CodeName = codeName Then
Set GetWsFromCodeName = ws
Exit For
End If
Next ws
End Function
Add this function in your code:
Sub FindReplace()
Dim FRep As Worksheet
Set FRep = GetWsFromCodeName("YourCodeName", ThisWorkbook)

Setting WKS to a Variable Sheet CodeName

I have 4 sheet codenames:
Summary
Credit
Debit
Comments
I want to execute a loop setting the WKS = codename but it's not working because I think when I set the array elements I'm using quotes which makes it more like a string than a sheet?
Code:
Dim sheetArray(4) as Variant
Dim wks as Worksheet
sheetArray(1) = "Summary"
sheetArray(2) = "Credit"
sheetArray(3) = "Debit"
sheetArray(4) = "Comments"
for i = 1 to 4
set wks = sheetArray(i)
...do stuff...
next
This isn't working for me... instead I have to do this which feels ugly.
Code:
for i = 1 to 4
if i = 1 then
set wks = Summary
elseif i = 2 then
....etc
Any tips on the syntax?
You need to set the array as worksheets then set each variable. And no quotes
Dim sheetArray(4) as Worksheet
Dim wks as Worksheet
Set sheetArray(1) = Summary
Set sheetArray(2) = Credit
Set sheetArray(3) = Debit
Set sheetArray(4) = Comments
for i = 1 to 4
set wks = sheetArray(i)
...do stuff...
next
This works for me as a variant
Sub test()
Dim sheetArray() As Variant
ReDim sheetArray(1 To 3)
sheetArray(1) = "Sheet1"
sheetArray(2) = "Sheet2"
sheetArray(3) = "Sheet3"
Dim ws As Worksheet
For i = LBound(sheetArray) To UBound(sheetArray)
Set ws = ThisWorkbook.Sheets(sheetArray(i))
MsgBox (ws.Name)
Next
End Sub
Alternatively you can set the worksheet name by referencing it directly. Using your first example:
Dim sheetArray(4) as Variant
Dim wks as Worksheet
sheetArray(1) = "Summary"
sheetArray(2) = "Credit"
sheetArray(3) = "Debit"
sheetArray(4) = "Comments"
for i = 1 to 4
wks.Name = sheetArray(i) ###This is the line I changed. Notice wks.Name
...do stuff...
next
If you need to loop through all the worksheets in a Workbook you can do it without using arrays and using their names as variables as it maybe changed at a later stage:
Sub WorksheetLoop()
' Declare Current as a worksheet object variable.
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
' Insert your code here.
' This line displays the worksheet name in a message box.
MsgBox Current.Name
Next
End Sub

How do I copy a range into a temp workbook and return a reference to it with a vba function?

I have the following which errors on the "rTemp.Value = vaTemp" line. What am I doing wrong here? Am I on the right track?
Function CreateTempRange(rSource As range) As range
' Declarations
Dim rTemp As range
Dim vaTemp As Variant
Dim wsTemp As Worksheet
Dim wbTemp As Workbook
' Open temp worksheet
Set wbTemp = Workbooks.Add
Set wsTemp = wbTemp.Worksheets.Add
' Copy range into it and get a reference to the temp range
vaTemp = rSource.Value
Set rTemp = wsTemp.range("A1").Resize(UBound(vaTemp, 1), UBound(vaTemp, 2))
rTemp.Value = vaTemp
' Return the temp range
Set CreateTempRange = rTemp
End Function
Note: This function is intended to be used by other functions and not called directly from a cell.
Set rTemp = wsTemp.range("A1").Resize(UBound(vaTemp, 1), UBound(vaTemp, 2)
There'll be a type mismatch here ... i'm not sure it really makes any sense. ubound(a,2) is used for multi-dimensional arrays not ranges.
I'm guessing you want to take the value in the cell specified then copy it many times depending on it's value. Is that correct?
Hopefully the below should give you an example to work with. If not edit your post and i'll see if i can help.
Function CreateTempRange(rSource As Range) As Range
'' Declarations
Dim rTemp As Range
Dim vaTemp As Variant
Dim wsTemp As Worksheet
Dim wbTemp As Workbook
'' Open temp worksheet
Set wbTemp = Workbooks.Add
Set wsTemp = wbTemp.Worksheets.Add
'' Copy range into it and get a reference to the temp range
vaTemp = rSource.Value
''Set rTemp = wsTemp.Range("A1").Resize(UBound(vaTemp, 1), UBound(vaTemp, 2))
Dim iTemp As Integer
On Error Resume Next
iTemp = CInt(vaTemp)
On Error GoTo 0
If iTemp < 1 Then
iTemp = 1
End If
Set rTemp = wsTemp.Range("A1:A" & iTemp)
rTemp.Value = vaTemp
'' Return the temp range
Set CreateTempRange = rTemp
End Function
Sub test()
Dim r As Range
Dim x As Range
Set r = ActiveSheet.Range("A1")
Set x = CreateTempRange(r)
End Sub
vaTemp = rSource.Value
As you aren't specifying the RangeValueDataType parameter to the Value method of the Range object, it will default to xlRangeValueDefault which, for non-empty ranges, will return an array of values. Therefore, the UBound(..., 1) and UBound(..., 2) parts make sense.
This would be easier:
Function CreateTempRange(rSource As range) As range
' Declarations
Dim rTemp As range
Dim wsTemp As Worksheet
Dim wbTemp As Workbook
' Open temp worksheet
Set wbTemp = Workbooks.Add
Set wsTemp = wbTemp.Worksheets.Add
' Create new range on that sheet starting at cell A1
Set rTemp = wsTemp.Range(Cells(1, 1), Cells(rSource.Rows.Count, _
rSource.Columns.Count))
rTemp.Value = rSource.Value
' Return the temp range
Set CreateTempRange = rTemp
End Function
You would still need some code to deal with ranges which consist of multiple areas (use the Areas.Count property to check for that)
I would do it like this
Function CreateTempRange(src As Range) As Range
Dim wbk As Workbook: Set wbk = Workbooks.Add
Dim sht As Worksheet: Set sht = wbk.Worksheets.Add
Call src.Copy(sht.Cells(1, 1))
Set CreateTempRange = Range(rSource.Address).Offset(1 - rSource.Row, 1 - rSource.Column)
End Function
Explanation of the last line of code (as requested):-
Range(rSource.Address) - this refers to the range on the current worksheet (containing the code) with the same local address as the source range, so if the the source range is C3:E5 on 'Sheet X' then Range(rSource.Address) refers to C3:E5 on the current sheet.
Since we pasted the copied range into the current sheet starting at cell A1 rather than cell C3 (I assume this is your requirement), we then need to offset this reference accordingly. The .Offset(1 - rSource.Row, 1 - rSource.Column) offsets this range negatively by both the row index (3) minus 1 and column index (C or 3) minus 1 of the source range, so that the final resulting reference starts with cell A1 and keeps the same dimensions as the source range.
Hope that helps.
Deano, that code works for me as written. What is the error you're getting?