Get worksheet as collection excel vba - excel

I'm building a basic Form Macro in excel. The user is passing the workbook object name i.e. the full file path and the worksheet name via my form. The macro needs to then open the activate the workbook, locate and activate the worksheet and then copy all the data on this sheet into a collection. The collection will be passed via ByRef or ByVal to another sub. I'm not efficient with Microsoft Excel VBA re its libraries, I work in a vb.net environment, the below code is what I would run in vb.net to get my worksheets data as a collection. You'll note in the code below there's three functions being used, GetWorksheet(), GetClipboardText() & ParseDelimSeparatedVariables(). Hoping someone may have a suggestion on how to recreate this is Excel VBA.
Assembly References: System.Data.dll, System.Xml.dll, System.Drawing.dll, System.Windows.Forms.dll
Namespace Imports: System, System.Drawing, System.Collections.Generic, System.IO, Microsoft.VisualBasic, System.Windows.Forms, System.Data, System.Diagnostics, System.Text, System.Threading, System.Runtime.InteropServices
Dim ws as Object = GetWorksheet(handle, workbookname, worksheetname, False)
' Do we have a sheet?
sheetexists = ws IsNot Nothing
' No sheet? No entry.
If Not sheetexists Then Return
ws.Activate()
ws.UsedRange.Select()
ws.UsedRange.Copy()
Dim data As String = GetClipboardText()
worksheetCollection = ParseDelimSeparatedVariables(data, vbTab, Nothing, True)
Below is the VBA code I've now got in place, currently getting a runtime error 9 subscript out of range error.
Sub getWSCol()
Dim wb As String
Dim wsName As String
Dim Arr() As Variant
Dim v As Variant
Dim colMailMerge As New Collection
wb = txtbxworkbook
wsName = txtbxworksheet
Workbooks(wb).Worksheets(wsName).Activate
Arr = Worksheets(wsName).UsedRange.Value
For Each v In Arr
col.Add v
Next v
End Sub
Image below of stepping through code

VBA lacks a lot of functions that make your life easy, so need to roll them all yourself.
Wouldn't a collection just result in a single dimension list of all the cell text? An array is probably better use case.
Dim Arr() as Variant
Arr = ws.UsedRange.value
I think if want a collection you'd have to loop through an array, can do it easily by then just
Dim Col as new Collection
Dim v as Variant
for each v in Arr
col.add v
next v
Getting worksheet, need to just reference by name in the Application.Workbooks(name).Worksheets(name) objects. It'll error if not there so need to what it on a function and error resume next past the errors, then can test if nothing outside of function.
For the sheet...
Dim Wk as workbook, Ws as worksheet
On error resume next
set wk = application.worksbooks(Wkbkname)
set ws = wk.worksheets(wsname)
on error goto 0
if ws is nothing then msgbox "Doesn't exist"
Arr = ws.UsedRange.Value

Related

Data Consolidation while excluding other sheets

this might be answered already from other posts I have read but still struggling to figure it out.
I have a workbook with 85 worksheets on it. Each sheet is like an invoice format, meaning it is not formatted as a normal data set. In order for me to get the data only I need, i created helper columns which only selects the data I need for consolidation. So I have a range I13:N42 which contains the data I need to consolidate.
At the end of the workbook, I already set up a Master Sheet with all the necessary headers for the data set. And there are 2 more worksheets namely "Tracking" & "AppControl" but I dont want them to be included in the loop together with the Master sheet.
For my range (filled with cell references/formulae), I need to copy only the row that has data in it.
You might have some ideas to improve the code I am currently using.
Sub Combine()
Dim i As Integer
Dim ws As Worksheet
Dim rng As Range
On Error Resume Next
For i = 1 To Sheets.Count
Sheets(i).Activate
Range("I13:N42").Select
Selection.Copy Destination:=Sheets("Master").Range("A65536").End(xlUp)(2)
Next i
End Sub
First remove On Error Resume Next. This line hides all error messages but the errors still occour, you just cannot see their messages. So if there are errors you cannot see you cannot fix them. If you don't fix them your code cannot work. Remove that line and fix your errors! Also see VBA Error Handling – A Complete Guide.
Second Avoid using Select in Excel VBA. That is a very bad practice and makes your code unreliable!
Option Explicit
Public Sub Combine()
Dim wsMaster As Worksheet ' set master worksheet
Set wsMaster = ThisWorkbook.Worksheets("Master")
Dim ExcludeWorksheets As Variant ' define worksheets names to exclude
ExcludeWorksheets = Array(wsMaster.Name, "Tracking", "AppControl")
Dim i As Long
For i = 1 To ThisWorkbook.Worksheets.Count
If Not IsInArray(ThisWorkbook.Worksheets(i).Name, ExcludeWorksheets) Then 'exclude these worksheets
ThisWorkbook.Worksheets(i).Range("I13:N42").Copy Destination:=wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp)(2)
End If
Next i
End Sub
Public Function IsInArray(ByVal StringToBeFound As String, ByVal Arr As Variant) As Boolean
IsInArray = (UBound(Filter(Arr, StringToBeFound)) > -1)
End Function
Alternatively you can use a For Each loop which looks a bit cleaner then
Option Explicit
Public Sub Combine()
Dim wsMaster As Worksheet ' set master worksheet
Set wsMaster = ThisWorkbook.Worksheets("Master")
Dim ExcludeWorksheets As Variant ' define worksheets names to exclude
ExcludeWorksheets = Array(wsMaster.Name, "Tracking", "AppControl")
Dim ws As Worksheet
For Each ws Is ThisWorkbook.Worksheets
If Not IsInArray(ws.Name, ExcludeWorksheets) Then 'exclude these worksheets
ws.Range("I13:N42").Copy Destination:=wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp)(2)
End If
Next ws
End Sub

I'm getting an 'object required' error when calling a vba function

I'm getting a 424 "Object Required" when calling a vba function. The function parameter requires a range to change the name of the worksheet tab to be the same as a cell value.
Here is the code:
Dim new_wb As Workbook
Dim act_wb As Workbook
Dim stu_name As Object
Dim lastRow As Long
Dim currCol As Long
Dim nameRange As Range
Set act_wb = ActiveWorkbook
currCol = ActiveCell.Column
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set nameRange = Worksheets(1).Range("A4")
'begin vba code
ActiveWorkbook.Sheets(1).copy
Worksheet_Change (nameRange) 'error occurs here.
Here is the function signature of the function being called:
Private Sub Worksheet_Change(ByVal Target As Range)
If I remove the 'Set' keyword for nameRange, I get the following error
As the comment to your OP said, Worksheet_Change is not a standalone procedure you define, but rather an event handler that you declare to provide functionality in response to the Worksheet class raising the Change event behind the scenes. If you would like to change the name shown in a worksheet tab based on a cell value just extract the string from that cell and assign it to the corresponding property of the sheet object:
Dim wsName As String
wsName = Worksheets(1).Range("A4").Value
Dim wS As Worksheet
Set wS = ActiveWorkbook.Sheets(1).Copy
wS.Name = wsName
I am confused why the worksheet and cell references are always the same but you should be able to adjust from there if needed. Happy coding!

VBA - Unable to set cell value

I am using the code below in a master workbook to open workbooks listed in the range E12:E24.
Once I have opened these workbooks, I need to count the number of open workbooks (in addition to the master workbook) and assign the number to cell E2 in the Portfolio Results sheet.
The code below works just as I would like except I get an error message on the line Worksheets("Portfolio Results").Range("E2") = nFields
It's unclear to me why this is the case. Thanks for any help.
Sub SkipBlankCells2()
Dim cell As Range, rng As Range, FName As String, nFields As Integer
Set rng = Range("E12:E24")
Application.DefaultFilePath = ActiveWorkbook.Path
nFields = 0
For Each cel In rng
If Len(cel) >= 1 Then
FName = cel.Value
Workbooks.Open Filename:=FName
nFields = nFields + 1
End If
Next cel
Debug.Print nFields
Worksheets("Portfolio Results").Range("E2") = nFields
End Sub
You should (almost always) have Option Explicit as your first line of the code.
Your current code contains an error, where you declared the variable
Dim cell as Range
but then in your For loop you're using an undeclared variable cel which defaults to a Variant data-type.
with Option Explicit enabled, the compiler will warn you about these kind of errors.
As to the actual answer, when switching between objects (be it Worksheet or Workbook) it's always a good programming practice to explicitly declare them.
Easiest way to access them is to store them inside a variable:
Dim wb as Workbook: Set wb = Workbooks("Static name")
Dim ws as Worksheet: Set ws = wb.Sheets("Your sheet name")
'later in the code
If wb.ws.Cells(1, 9) = "banana" Then '...
Not only this makes for a more read-able code for somebody else (because if somebody inherits your project, they can't know which workbook or worksheet intended the author to work with), but it also prevents these unnecessary kind of errors where a different Workbook or Worksheet is selected.
As a final note, if you don't know which Workbook might be open at the moment, but want to reference "this" specific one, then use ThisWorkbook instead

Trying to delete a sheet and create a new ones

I'm trying to run the program so that it deletes an already existing sheet, create a new one so that I can fill it with results. I want to be able to do this every time I run the program so that I get a new sheet without the previous results.
Dim CustomerID As Integer
Dim SameID As Integer
Dim TotalSpent As Currency
Dim HighSpenders As Integer
Dim CustomerOrder As Integer
Dim DataCell As Range
Dim ReportCell As Range
Dim UserAmount As Variant
Dim UserAmount1 As Integer
Dim wsData As Worksheet
Dim wsReport As Worksheet
Set wsData = ActiveWorkbook.Sheets("Data")
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Report").Delete
On Error GoTo -1
Application.DisplayAlerts = True
Do
UserAmount = InputBox("Enter an amount")
If Not IsNumeric(UserAmount) Then
MsgBox "Enter a numeric value"
Else
UserAmount1 = CInt(UserAmount)
End If
Loop While Not IsNumeric(UserAmount)
Set wsReport = ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Report"
Set DataCell = wsData.Range("A3")
Set ReportCell = wsReport.Range("A3")
Problem now is that it's not creating a new worksheet called Report with the results
Delete Sheet ft. On Error Goto 0
If this code is in the ActiveWorkbook, you should use
ThisWorkbook instead, or refer to it by its name e.g. Workbooks(CreateReport.xlsm).
Use the With statement for objects to make the code more readable and
avoid unnecessary reference errors:
The paremeter part of the After argument After:=Sheets(Sheets.Count) ' is, I would say, incorrect and should have been:
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count).
Why does it then still work correctly? It's because when omitting ActiveWorkbook, the ActiveWorkbook is actually used ('understood', 'default'). You could have omitted all the ActiveWorkbook references you used and all the Sheets would still have (correctly) referred to the ActiveWorkbook's sheets.
Why incorrect? You have decided to change all the ActiveWorkbook instances to Workbooks("CreateReport.xlsm"). You will probably not add the reference in the After argument, which could give you undesired results because it's referring to the ActiveWorkbook, which could be another workbook (not CreateReport.xlsm).
The last part lead us to another benefit of using the With statement, namely if you want to change the reference of the workbook, you will have to change it only in the With statement (once) e.g.:
With Workbooks("CreateReport.xlsm")
VBA
does not support On Error Goto -1, Visual
Basic
does. If you would have used
On Error Goto 0,
the code would have produced Run-time error '424': Object required and would have highlighted the line Set wsReport = ... and you would have immediately known that this was the line that had to be changed.
You can use the same variable UserAmount (as Variant) instead of
UserAmount1. To prevent Run-time error '6': Overflow when entering
a value that exceeds the Integer limit e.g. 32768, you should use
Long instead of Integer:
UserAmount = CLng(UserAmount)
' or:
Dim UserAmount1 as Long
...
UserAmount1 = Clng(UserAmount)
if you'll stick with variable UserAmount1.
You cannot Add a new worksheet and rename it in one go (in the same
line). You have to use two lines:
With ActiveWorkbook
Set wsReport = .Sheets.Add(After:=.Sheets(.Sheets.Count))
End With
wsReport.Name = "Report"
It is good practice to create titles or shortly describe various
sections of the code. I've probably added too many.
The Code
Sub AddSheet()
Dim CustomerID As Integer
Dim SameID As Integer
Dim TotalSpent As Currency
Dim HighSpenders As Integer
Dim CustomerOrder As Integer
Dim DataCell As Range
Dim ReportCell As Range
Dim UserAmount As Variant
'Dim UserAmount1 As Long
Dim wsData As Worksheet
Dim wsReport As Worksheet
' If this code is in the ActiveWorkbook, use ThisWorkbook instead.
With ThisWorkbook
' Create a reference to Data Sheet.
Set wsData = .Sheets("Data")
' Delete (old) Report Sheet.
On Error Resume Next
Application.DisplayAlerts = False
.Sheets("Report").Delete
Application.DisplayAlerts = True
On Error GoTo 0 ' VBA doesn't support On Error Goto -1
' Input UserAmount.
Do
UserAmount = InputBox("Enter an amount")
If Not IsNumeric(UserAmount) Then
MsgBox "Enter a numeric value"
Else
' You can use the same variable.
' To prevent "Run-time error '6': Overflow" when entering a
' value that exceeds the integer limit e.g. 32768, you have
' to use Long.
UserAmount = CLng(UserAmount)
'UserAmount1 = CLng(UserAmount)
End If
Loop While Not IsNumeric(UserAmount)
' Create a reference to a newly added sheet.
Set wsReport = .Sheets.Add(After:=.Sheets(.Sheets.Count))
End With
' Rename the newly added sheet.
wsReport.Name = "Report"
' Create references to cells "A3" of both worksheets.
Set DataCell = wsData.Range("A3")
Set ReportCell = wsReport.Range("A3")
End Sub
You re not declaring or Setting wsData or wsReport. This will at least set wsReport to the newly created worksheet.
Dim CustomerID As Integer, SameCustomerID As Integer
Dim TotalSpent As Currency
Dim HighSpenders As Integer, CustomerOrder As Integer, UserAmount1 As Integer
Dim DataCell As Range, ReportCell As Range
Dim UserAmount As Variant
dim wsData as worksheet, wsReport as worksheet
application.displayalerts = false 'do NOT ask for confirmation
on error resume next 'if Reports doesn't exist, keep going
ActiveWorkbook.Sheets("Report").Delete
on error goto -1 'reset the error handler
application.displayalerts = true 'turn alerts back on
Do
UserAmount = InputBox("Enter an amount")
If Not IsNumeric(UserAmount) Then
MsgBox "Enter a numeric value"
Else
UserAmount1 = CInt(UserAmount)
End If
Loop While Not IsNumeric(UserAmount)
set wsReport = ActiveWorkbook.workSheets.Add(After:=Sheets(Sheets.Count))
with wsReport
.Name = "Report"
end with
Set ReportCell = wsReport.Range("A3")
'wsData is still not set to any worksheet
Set DataCell = wsData.Range("A3")

Take data from all books to some table

I am very new in EXCEL (especially in VBA). I try to write logic that:
go to all open books, if some book has sheet with name "Test", it should take data from named range "Table" and then append it to the Table1 from sheet ALLDATA in book ALLDATABOOK. I try to write this, can someone help me?
Here is my code:
Private Sub CommandButton1_Click()
Dim book As Object
Dim lst As ListObject
Dim iList As Worksheet
For Each book In Workbooks
For Each iList In book.Sheets
If iList.Name = "Test" Then
book.Sheets(iList.Name).Activate
Range("Table").Select
End If
Next
Next
End Sub
Try this (written for Excel 2007+, may not work for earlier versions)
Private Sub CommandButton1_Click()
Dim book As Workbook
Dim lst As ListObject
Dim iList As Worksheet
Dim Rng As Range
Dim wbAllDataBook As Workbook
Dim shAllData As Worksheet
' Get reference to ALLDATA table
Set wbAllDataBook = Workbooks("ALLDATABOOK.xlsm") '<-- change to suit your file extension
Set shAllData = wbAllDataBook.Worksheets("ALLDATA")
Set lst = shAllData.ListObjects("Table1")
For Each book In Workbooks
' Use error handler to avoid looping through all worksheets
On Error Resume Next
Set iList = book.Worksheets("Test")
If Err.Number <> 0 Then
' sheet not present in book
Err.Clear
On Error GoTo 0
Else
' If no error, iList references sheet "Test"
On Error GoTo 0
' Get Reference to named range
Set Rng = iList.[Table]
' Add data to row below existing data in table. Table will auto extend
If lst.DataBodyRange Is Nothing Then
' Table is empty
lst.InsertRowRange.Resize(Rng.Rows.Count).Value = Rng.Value
Else
With lst.DataBodyRange
.Rows(.Rows.Count).Offset(1, 0).Resize(Rng.Rows.Count).Value = Rng.Value
End With
End If
End If
Next
End Sub
Update:
To use with Excel 2003 replace
If lst.DataBodyRange Is Nothing Then
with
If Not lst.InsertRowRange Is Nothing Then

Resources