I am trying to import a spreadsheet that has a question on each row along with 4 possible answers. I can successfully read the cell values, but the correct answer is indicated by a fill pattern (50% Gray). I am using the code below to loop through the worksheet and pick out the correct answers. However, the value of Pattern seems to be the same for all columns, even though the pattern is plainly visible on the worksheet. Am I looking in the wrong place?
The worksheet is an .xls file. I am using Excel 2010 and VS 2010.
Dim dt As New System.Data.DataTable
Dim wks As Worksheet = wkb.Worksheets(1)
Dim ur As Range = wks.UsedRange
' Load all cells into an array.
Dim SheetData(,) As Object = ur.Value(XlRangeValueDataType.xlRangeValueDefault)
' Loop through all cells.
For j As Integer = 1 To SheetData.GetUpperBound(0)
For k As Integer = 1 To (SheetData.GetUpperBound(1) - 1)
'Get the pattern for the cells in columns 7 - 10
If (k > 6) And (k < 11) Then
Dim r As Range = wks.Cells(j, k)
Dim s As Style = r.Style
If s.Interior.Pattern = XlPattern.xlPatternGray50 Then
'Convert column index to "A" - "D"
Dim key As Char = ChrW(k + 58)
'Do something with key
End If
End If
Next
Next
I looked in MSDN but they give little or no explanation of how styles are stored in the object model. The few examples that I have seen show using the Style.Interior.Pattern to set the value after selecting the cell. Do I need to select the cell to read the pattern?
Any help would be appreciated.
Interior.Pattern is accessible from a Range object. The Range interface/object contains all the style and value information for the range.
The Style property of the Range object refers to Styles that are definied at workbook level ("shared" styles).
From MSDN:
The Style object contains all style attributes (font, number format, alignment, and so on) as properties. There are several built-in styles, including Normal, Currency, and
Percent. Using the Style object is a fast and efficient way to change
several cell-formatting properties on multiple cells at the same time.
In your case (where the styles seems to be definied at cell level and not by using a "shared" style), you just need to replace:
Dim r As Range = wks.Cells(j, k)
Dim s As Style = r.Style
If s.Interior.Pattern = XlPattern.xlPatternGray50 Then
With:
Dim r As Range = wks.Cells(j, k)
'Dim s As Style = r.Style 'no need
If r.Interior.Pattern = XlPattern.xlPatternGray50 Then
Related
I've built a name range for 20 cells so that I can input a new list of projects which will vary from 1 to 20. I want to write a macro so that it reads the number of projects and creates the correct number of tabs, and names the tab after the project name listed in the named range. I've done all of this except I can't get the countA function to work. The named range is csCount. if I change the For loop to the correct number in one instance (if I put 7 because right now I have 7 projects) the loop and macro are correct. I want to make it more dynamic using the countA. Thank you very much for the help.
Sub generateDepartments()
Dim tabs As Integer
Dim sName As String
Dim i As Integer
Dim j As Integer
Dim csCount As Variant
tabs = Application.CountA(csCount)
j = 5
i = tabs
For i = 2 To Application.CountA(csCount)
Worksheets("Input").Activate
sName = Cells(j, 3).Value
Worksheets.Add(after:=Worksheets(i)).Name = sName
j = j + 1
Next
End Sub
First you need to create a variable to access your named range: Set csCount = ActiveWorkbook.Names("csCount").RefersToRange or Set csCount = ActiveSheet.Range("csCount")
Then use Application.WorksheetFunction.CountA(csCount)
Also, is better to define as a Range instead of Variant Dim csCount As Range
I have worked in Python earlier where it is really smooth to have a dictionary of lists (i.e. one key corresponds to a list of stuff). I am struggling to achieve the same in vba. Say I have the following data in an excel sheet:
Flanged_connections 6
Flanged_connections 8
Flanged_connections 10
Instrument Pressure
Instrument Temperature
Instrument Bridle
Instrument Others
Piping 1
Piping 2
Piping 3
Now I want to read the data and store it in a dictionary where the keys are Flanged_connections, Instrument and Piping and the values are the corresponding ones in the second column. I want the data to look like this:
'key' 'values':
'Flanged_connections' '[6 8 10]'
'Instrument' '["Pressure" "Temperature" "Bridle" "Others"]'
'Piping' '[1 2 3]'
and then being able to get the list by doing dict.Item("Piping") with the list [1 2 3] as the result. So I started thinking doing something like:
For Each row In inputRange.Rows
If Not equipmentDictionary.Exists(row.Cells(equipmentCol).Text) Then
equipmentDictionary.Add row.Cells(equipmentCol).Text, <INSERT NEW LIST>
Else
equipmentDictionary.Add row.Cells(equipmentCol).Text, <ADD TO EXISTING LIST>
End If
Next
This seems a bit tedious to do. Is there a better approach to this? I tried searching for using arrays in vba and it seems a bit different than java, c++ and python, with stuft like redim preserve and the likes. Is this the only way to work with arrays in vba?
My solution:
Based on #varocarbas' comment I have created a dictionary of collections. This is the easiest way for my mind to comprehend what's going on, though it might not be the most efficient. The other solutions would probably work as well (not tested by me). This is my suggested solution and it provides the correct output:
'/--------------------------------------\'
'| Sets up the dictionary for equipment |'
'\--------------------------------------/'
inputRowMin = 1
inputRowMax = 173
inputColMin = 1
inputColMax = 2
equipmentCol = 1
dimensionCol = 2
Set equipmentDictionary = CreateObject("Scripting.Dictionary")
Set inputSheet = Application.Sheets(inputSheetName)
Set inputRange = Range(Cells(inputRowMin, inputColMin), Cells(inputRowMax, inputColMax))
Set equipmentCollection = New Collection
For i = 1 To inputRange.Height
thisEquipment = inputRange(i, equipmentCol).Text
nextEquipment = inputRange(i + 1, equipmentCol).Text
thisDimension = inputRange(i, dimensionCol).Text
'The Strings are equal - add thisEquipment to collection and continue
If (StrComp(thisEquipment, nextEquipment, vbTextCompare) = 0) Then
equipmentCollection.Add thisDimension
'The Strings are not equal - add thisEquipment to collection and the collection to the dictionary
Else
equipmentCollection.Add thisDimension
equipmentDictionary.Add thisEquipment, equipmentCollection
Set equipmentCollection = New Collection
End If
Next
'Check input
Dim tmpCollection As Collection
For Each key In equipmentDictionary.Keys
Debug.Print "--------------" & key & "---------------"
Set tmpCollection = equipmentDictionary.Item(key)
For i = 1 To tmpCollection.Count
Debug.Print tmpCollection.Item(i)
Next
Next
Note that this solution assumes that all the equipment are sorted!
Arrays in VBA are more or less like everywhere else with various peculiarities:
Redimensioning an array is possible (although not required).
Most of the array properties (e.g., Sheets array in a Workbook) are 1-based. Although, as rightly pointed out by #TimWilliams, the user-defined arrays are actually 0-based. The array below defines a string array with a length of 11 (10 indicates the upper position).
Other than that and the peculiarities regarding notations, you shouldn't find any problem to deal with VBA arrays.
Dim stringArray(10) As String
stringArray(1) = "first val"
stringArray(2) = "second val"
'etc.
Regarding what you are requesting, you can create a dictionary in VBA and include a list on it (or the VBA equivalent: Collection), here you have a sample code:
Set dict = CreateObject("Scripting.Dictionary")
Set coll = New Collection
coll.Add ("coll1")
coll.Add ("coll2")
coll.Add ("coll3")
If Not dict.Exists("dict1") Then
dict.Add "dict1", coll
End If
Dim curVal As String: curVal = dict("dict1")(3) '-> "coll3"
Set dict = Nothing
You can have dictionaries within dictionaries. No need to use arrays or collections unless you have a specific need to.
Sub FillNestedDictionairies()
Dim dcParent As Scripting.Dictionary
Dim dcChild As Scripting.Dictionary
Dim rCell As Range
Dim vaSplit As Variant
Dim vParentKey As Variant, vChildKey As Variant
Set dcParent = New Scripting.Dictionary
'Don't use currentregion if you have adjacent data
For Each rCell In Sheet2.Range("A1").CurrentRegion.Cells
'assume the text is separated by a space
vaSplit = Split(rCell.Value, Space(1))
'If it's already there, set the child to what's there
If dcParent.Exists(vaSplit(0)) Then
Set dcChild = dcParent.Item(vaSplit(0))
Else 'create a new child
Set dcChild = New Scripting.Dictionary
dcParent.Add vaSplit(0), dcChild
End If
'Assumes unique post-space data - text for Exists if that's not the case
dcChild.Add CStr(vaSplit(1)), vaSplit(1)
Next rCell
'Output to prove it works
For Each vParentKey In dcParent.Keys
For Each vChildKey In dcParent.Item(vParentKey).Keys
Debug.Print vParentKey, vChildKey
Next vChildKey
Next vParentKey
End Sub
I am not that familiar with C++ and Python (been a long time) so I can't really speak to the differences with VBA, but I can say that working with Arrays in VBA is not especially complicated.
In my own humble opinion, the best way to work with dynamic arrays in VBA is to Dimension it to a large number, and shrink it when you are done adding elements to it. Indeed, Redim Preserve, where you redimension the array while saving the values, has a HUGE performance cost. You should NEVER use Redim Preserve inside a loop, the execution would be painfully slow
Adapt the following piece of code, given as an example:
Sub CreateArrays()
Dim wS As Worksheet
Set wS = ActiveSheet
Dim Flanged_connections()
ReDim Flanged_connections(WorksheetFunction.CountIf(wS.Columns(1), _
"Flanged_connections"))
For i = 1 To wS.Cells(1, 1).CurrentRegion.Rows.Count Step 1
If UCase(wS.Cells(i, 1).Value) = "FLANGED_CONNECTIONS" Then ' UCASE = Capitalize everything
Flanged_connections(c1) = wS.Cells(i, 2).Value
End If
Next i
End Sub
the line that is giving me trouble is ""Sheets(CStr(WS_M.Cells(n, START_C))).Cells(n, START_C).Paste""
this is supposed to find the tab name in column 3 and go to that tab and paste the tab name in that tab.
Const START_C = 3
Const MAX_TRAN = 1000
Const START_R = 2
Const MASTER = "MASTER"
Sub MOVEDATACORRECTLY()
Dim WS_M As Worksheet
Dim thisWB As Workbook
Set thisWB = ActiveWorkbook
Set WS_M = Worksheets(MASTER)
For M = START_R To (START_R + MAX_TRAN)
If WS_M.Cells(M, (START_C + 1)) = "" Then Exit For
Next M
M = M - 1
For n = START_R To M
WS_M.Cells(n, START_C).Copy
Sheets(CStr(WS_M.Cells(n, START_C))).Cells(n, START_C).Paste
Next n
End Sub
Try this instead:
For n = START_R To M
WS_M.Cells(n, START_C).Copy
Sheets(CStr(WS_M.Cells(n, START_C))).Cells(n, START_C).Select
ActiveSheet.Paste
Next n
If you look at the documentation for the Excel Range object, Paste is not in the list of members. There is PasteSpecial, however. I haven't experimented with that, but that might also work.
For copying a range of cells in Excel, using Copy method makes the VBA program easier to crash / or to give inpredictable results.
Suppose during the your procedure copies data from system clipboard and user was trying to store some other to system clipboard!
Not always, but from users this kind of mistake might happened.
So I always prefer to use a better approach, something like Swaping the range on the fly. Here's a small demonstration:
Public Sub Sample_Copy_without_Clipboard()
Dim dRange As Range, iRange As Range
Set iRange = Range("A1:B3")
Set dRange = Range("D1:E3")
dRange.Value = iRange.Value
End Sub
Note: This method works only with unformatted textual data. If not then either use Tim's suggestion or DanM's answer.
I am writing a function to export data to Excel using the Office Interop in VB .NET. I am currently writing the cells directly using the Excel worksheet's Cells() method:
worksheet.Cells(rowIndex, colIndex) = data(rowIndex)(colIndex)
This is taking a long time for large amounts of data. Is there a faster way to write a lot of data to Excel at once? Would doing something with ranges be faster?
You should avoid reading and writing cell by cell if you can. It is much faster to work with arrays, and read or write entire blocks at once. I wrote a post a while back on reading from worksheets using C#; basically, the same code works the other way around (see below), and will run much faster, especially with larger blocks of data.
var sheet = (Worksheet)Application.ActiveSheet;
var range = sheet.get_Range("A1", "B2");
var data = new string[3,3];
data[0, 0] = "A1";
data[0, 1] = "B1";
data[1, 0] = "A2";
data[1, 1] = "B2";
range.Value2 = data;
If you haven't already, make sure to set Application.ScreenUpdating = false before you start to output your data. This will make things go much faster. The set it back to True when you are done outputting your data. Having to redraw the screen on each cell change takes a good bit of time, bypassing this saves that.
As for using ranges, you still will need to target 1 (one) specific cell for a value, so I see no benefit here. I am not aware of doing this any faster than what you are doing in regards to actually outputting the data.
Just to add to Tommy's answer.
You might also want to set the calculation to manual before you start writing.
Application.Calculation =
xlCalculationManual
And set it back to automatic when you're done with your writing. (if there's a chance that the original mode could have been anything other than automatic, you will have to store that value before setting it to manual)
Application.Calculation =
xlCalculationAutomatic
You could also use the CopyFromRecordset method of the Range object.
http://msdn.microsoft.com/de-de/library/microsoft.office.interop.excel.range.copyfromrecordset(office.11).aspx
The fastest way to write and read values from excel ranges is Range.get_Value and Range.set_Value.
The way is as below:
Range filledRange = Worksheet.get_Range("A1:Z678",Missing);
object[,] rngval = (object[,]) filledRange.get_Value (XlRangeValueDataType.xlRangeValueDefault);
Range Destination = Worksheet2.get_Range("A1:Z678",Missing);
destination.set_Value(Missing,rngval);
and yes, no iteration required. Performance is just voila!!
Hope it helps !!
Honestly, the fastest way to write it is with comma delimiters. It's easier to write a line of fields using the Join(",").ToString method instead of trying to iterate through cells. Then save the file as ".csv". Using interop, open the file as a csv which will automatically do the cell update for you upon open.
In case someone else comes along like me looking for a full solution using the method given by #Mathias (which seems to be the fastest for loading into Excel) with #IMil's suggestion on the Array.
Here you go:
'dt (DataTable) is the already populated DataTable
'myExcelWorksheet (Worksheet) is the worksheet we are populating
'rowNum (Integer) is the row we want to start from (usually 1)
Dim misValue As Object = System.Reflection.Missing.Value
Dim arr As Object = DataTableToArray(dt)
'Char 65 is the letter "A"
Dim RangeTopLeft As String = Convert.ToChar(65 + 0).ToString() + rowNum.ToString()
Dim RangeBottomRight As String = Convert.ToChar(65 + dt.Columns.Count - 1).ToString() + (rowNum + dt.Rows.Count - 1).ToString()
Dim Range As String = RangeTopLeft + ":" + RangeBottomRight
myExcelWorksheet.Range(Range, misValue).NumberFormat = "#" 'Include this line to format all cells as type "Text" (optional step)
'Assign to the worksheet
myExcelWorksheet.Range(Range, misValue).Value2 = arr
Then
Function DataTableToArray(dt As DataTable) As Object
Dim arr As Object = Array.CreateInstance(GetType(Object), New Integer() {dt.Rows.Count, dt.Columns.Count})
For nRow As Integer = 0 To dt.Rows.Count - 1
For nCol As Integer = 0 To dt.Columns.Count - 1
arr(nRow, nCol) = dt.Rows(nRow).Item(nCol).ToString()
Next
Next
Return arr
End Function
Limitations include only allowing 26 columns before it would need better code for coming up with the range value letters.
Is there a method available for copying a section out of a shape to another shape using VBA? I'm specifically trying to copy all the custom properties and user cells from one pagesheet to another page.
Unfortunately there isn't a simple method to do this. You will have to loop over all the rows in the source sheet and create the same rows in the destination sheet. E.g.:
Dim oPageSheet1 As Visio.Shape
Dim oPageSheet2 As Visio.Shape
Dim rowName As String
Dim i As Integer
Set oPageSheet1 = Visio.ActiveDocument.Pages.Item(1).PageSheet
Set oPageSheet2 = Visio.ActiveDocument.Pages.Item(2).PageSheet
i = visRowUser
While oPageSheet1.CellsSRCExists(visSectionUser, i, visUserValue, False)
oPageSheet2.AddNamedRow visSectionUser, oPageSheet1.Section(visSectionUser).Row(i).NameU, 0
oPageSheet2.Section(visSectionUser).Row(i).Name = oPageSheet1.Section(visSectionUser).Row(i).Name
oPageSheet2.CellsSRC(visSectionUser, i, visUserValue).FormulaU = oPageSheet1.CellsSRC(visSectionUser, i, visUserValue).FormulaU
oPageSheet2.CellsSRC(visSectionUser, i, visUserPrompt).FormulaU = oPageSheet1.CellsSRC(visSectionUser, i, visUserPrompt).FormulaU
i = i + 1
Wend
If you have to copy a large number of rows and performance is a consideration you should investigate using AddRows and SetFormulas.