I am trying to loop through a named range in Excel and set its value equal to another named range that is dynamic in value (called SensitivityResults). How do I get Excel to essentially say:
Range("Scenario1").Value = Range("SensitivityResults").Value
Range("Scenario2").Value = Range("SensitivityResults").Value
Range("Scenario2").Value = Range("SensitivityResults").Value
etc...
My code as follows does not work:
Dim i As Integer
Dim s As Integer
For i = 1 To 20
For s = 1 To 20
Range("Active_Scenaro") = s
Calculate
Range("Scenario(i)").Value = Range("SensitivityResults").Value
Next s
Next i
You just need to append the counter i as string to your fixed name Scenario:
Range("Scenario" & i).Value = Range("SensitivityResults").Value
Related
I need to export the Catia Spec tree to use as a BoM.
The Export Should:
Go to Excel and will use the WalkDownTree function.
Have the PartNumber, Nomenclature and a User Added
Property called "Sinex Ref".
It will also have to make sure that the Exported Tree ignores Parts
and Products called "Ref".
Present the Quantity of each item using the
PartNumber.
Include the deactivated parts but mention that they
are deactivated.
I'm new to Catia and VBA and have come up with the following (I made adjustments to other macros that i have found but noticed that they ignore the children in the Tree). Currently the macro generates the Excel file and in the same cell cycles through all of the parts and children in the spec tree, regardless if they're deactivated or not.
Sub CATMain()
' ********* is the current document a CATIA Product **************
If CATIA.Documents.Count = 0 Then
MsgBox "There are no CATIA documents open. Please open a CATIA document and try again.", ,msgboxtext
Exit Sub
End If
If InStr(CATIA.ActiveDocument.Name, ".CATProduct") < 1 Then
MsgBox "The active document is not a Product. Please open a CATIA Product and try again.", ,msgboxtext
Exit Sub
End If
' ************* General declarations for the Active CATIA session *****************
Dim oProdDoc As ProductDocument
t = 1
Set oProdDoc = CATIA.ActiveDocument
Dim oRootProd As Product
Set oRootProd = oProdDoc.Product
Dim par As Parameters
Set par = oRootProd.UserRefProperties
Dim SinexRef As String
' *************** begin spec tree scroll ******************
Call WalkDownTree(oRootProd)
End Sub
Sub WalkDownTree(oInProduct As Product)
Dim oInstances As Products
Set oInstances = oInProduct.Products
On Error Resume Next
Set Excel = GetObject(, "EXCEL.Application")
If Err.Number <> 0 Then
Set Excel = CreateObject("EXCEL.Application")
Excel.Visible = True
Excel.Workbooks.Add
End If
If t <> 1 Then
for i=1 to oInProduct.Count
'**************************** Export title ***************************
row=2
col=1
Excel.Columns.Columns(1).Columnwidth = 5
Excel.Columns.Columns(2).Columnwidth = 15
Excel.Cells(row,col+1).Value = "CATProduct:"
Excel.Cells(row,col+1).Font.Bold = true
Excel.Cells(row,col+1).HorizontalAlignment = 3
Excel.Cells(row,col+2).Value = CATIA.ActiveDocument.Name
' **************************** Export column titles ***************
row=4
Excel.Cells(row,col+1).Value = "Instance Name"
Excel.Cells(row,col+1).Font.Bold = true
Excel.Columns.Columns(2).Columnwidth = 20
Excel.Cells(row,col+1).borders.LineStyle = 1
Excel.Cells(row,col+1).HorizontalAlignment = 3
Excel.Cells(row+2,col+1).Value = oInProduct.ReferenceProduct.PartNumber
Excel.Cells(row,col+2).Value = "Ref"
Excel.Cells(row,col+2).Font.Bold = true
Excel.Columns.Columns(3).Columnwidth = 15
Excel.Cells(row,col+2).borders.LineStyle = 1
Excel.Cells(row,col+2).HorizontalAlignment = 3
Excel.Cells(row+2,col+2).Value = oInProduct.ReferenceProduct.Nomenclature
Excel.Cells(row,col+3).Value = "Quantity"
Excel.Cells(row,col+3).Font.Bold = true
Excel.Columns.Columns(4).Columnwidth = 15
Excel.Cells(row,col+3).borders.LineStyle = 1
Excel.Cells(row,col+3).HorizontalAlignment = 3
Excel.Cells(row+2,col+3).Value = 1 'insert item quantity corresponding to PartNumber
Excel.Cells(row,col+4).Value = "SinexRef"
Excel.Cells(row,col+4).Font.Bold = true
Excel.Columns.Columns(5).Columnwidth = 15
Excel.Cells(row,col+4).borders.LineStyle = 1
Excel.Cells(row,col+4).HorizontalAlignment = 3
Excel.Cells(row+2,col+4).Value = 1 'insert Sinex Ref corresponding to PartNumber
t = t + 1
Next
End If
Dim k As Integer
For k = 1 To oInstances.Count
Dim oInst As Product
Set oInst = oInstances.Item(k)
Call WalkDownTree(oInst)
Next
End Sub
Assuming by
in the same cell cycles through all of the parts and children in the spec tree
you mean that it is writing/overwriting data from CATIA in the same cell, that is because you aren't incrementing anything regarding Excel rows/columns.
I personally would create headers for things like CATProduct, Instance Name, etc. then put pure data below instead of repeating these identical headers every single time, but your format will work as well, it might just be more difficult to summarize data in Excel.
Anyway, to maintain your existing format, you need to increment your Row at the end of your loop, around where t is incremented.
In the existing loop, it appears that rows 2-6 are used (5 rows total) for the first oInProduct. There is a row = 2 at the beginning of the loop which needs to be put just before the loop, this means it will start from the second row. There is also a row = 4 inside the loop which needs to be changed, we can use row = row + 2 to get the same effect. Then, at the end of the loop, we increment again to reach that total of 5, so use row = row + 3.
row = 2
for i = 1 to oInProduct.Count
'**************************** Export title ***************************
col=1
Excel.Columns.Columns(1).Columnwidth = 5
...
row = row + 2 'previously row = 4
...
Excel.Cells(row,col + 4).HorizontalAlignment = 3
Excel.Cells(row + 2,col + 4).Value = 1 'insert Sinex Ref corresponding to PartNumber
t = t + 1
row = row + 3
Next
Try
-->Analyze-->Bill of Material-->Define Format (for optional options)-->>Save as-->File format as .xls
Or:
-->File--> Save As --> Filetype:txt...Sure it's txt but maybe you can convert to .xls
(expecially if you have missing licenses)
I have used AssemblyConverter object which is available in Catia libraries to extract BOM.I found this when I recorded macro using the steps mentioned in above comment.
Try -->Analyze-->Bill of Material-->Define Format (for optional options)-->>Save as-->File format as .xls
I think this is the simplest and fast. Also, we can change format and location of file too.
Recorded Macro:
Sub CATMain()
Dim productDocument1 As ProductDocument
Set productDocument1 = CATIA.ActiveDocument
Dim product1 As Product
Set product1 = productDocument1.Product
Dim assemblyConvertor1 As AssemblyConvertor
Set assemblyConvertor1 = product1.GetItem("BillOfMaterial")
Dim arrayOfVariantOfBSTR1(4)
arrayOfVariantOfBSTR1(0) = "Quantity"
arrayOfVariantOfBSTR1(1) = "Part Number"
arrayOfVariantOfBSTR1(2) = "Type"
arrayOfVariantOfBSTR1(3) = "Nomenclature"
arrayOfVariantOfBSTR1(4) = "Revision"
Set assemblyConvertor1Variant = assemblyConvertor1
assemblyConvertor1Variant.SetCurrentFormat arrayOfVariantOfBSTR1
Dim arrayOfVariantOfBSTR2(1)
arrayOfVariantOfBSTR2(0) = "Quantity"
arrayOfVariantOfBSTR2(1) = "Part Number"
Set assemblyConvertor1Variant = assemblyConvertor1
assemblyConvertor1Variant.SetSecondaryFormat arrayOfVariantOfBSTR2
assemblyConvertor1.[Print] "XLS", "C:\Users\Desktop\BOM.xls", product1
End Sub
I'm trying to write a macro that allows a user to enter a new banknote serial number. The macro requires 3 inputs (currency, denomination and serial number). I'm a beginner to VBA, but the code I tried to write is below. Can anyone point out where I went wrong, or what needs to be changed to make it work? Thanks!
Sub TestSub()
Dim Note_Serial As Variant
Dim Note_Currency As Variant
Dim Note_Denomination As Variant
'Defining 3 inputs
Note_Currency = InputBox("Enter Currency (in 3 letter form):")
Note_Denomination = InputBox("Enter Note Denomination (with $ sign):")
Note_Serial = InputBox("Enter Serial Number:")
'Getting 3 inputs
Dim Currency_Cell As Range
Dim Denomination_Cell As Range
Dim Serial_Cell As Range
'Defining cells to write inputs
Currency_Cell = (D3)
Denomination_Cell = (E3)
Serial_Cell = (F3)
'Starting cells
Currency_Cell = Note_Currency
Denomination_Cell = Note_Denomination
Serial_Cell = Note_Serial
'Writing inputs to spreadsheet
Currency_Cell.Offset (1)
Denomination_Cell.Offset (1)
Serial_Cell.Offset (1)
'Moving all cells down 1 place
End Sub
Instead of writing Currency_Cell = (D3), you want to write Set Currency_Cell = Range("D3") (Assuming that you don't switch the active Worksheet).
EDIT: To prevent overwriting previously entered data, use instead:
Set Currency_Cell = Cells(Rows.Count, Range("D3").Column).End(xlUp).Offset(1, 0)
This will select the first empty Cell in Column D.
To move the cell reference, you have to also use the Set keyword, and give the offset in rows and columns:
Set Currency_Cell = Currency_Cell.Offset (1, 0)
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
My Excel looks like this
A B C D
1 2 3
I use this,
Dim row As DocumentFormat.OpenXml.Spreadsheet.Row = sheetData.Descendants(Of DocumentFormat.OpenXml.Spreadsheet.Row)().FirstOrDefault(Function(y) y.RowIndex.Value = 1)
I only get 3 Cells (B,C,D) in my result. How do i include the blank spaces?
Excel file contains only cells filled with their addresses. Empty cells are "virtual".
You can check by address cells, the "missing" cells are .
To translate the address (which is in "A1" style) to number index, you can use this function (credit: codeproject Article: Read and Write Microsoft Excel with Open XML SDK):
dim regexColName = New Regex("[A-Za-z]+", RegexOptions.Compiled)
Private Function ConvertCellReferenceToNumber(cellReference As String) As Integer
Dim colLetters = regexColName.Match(cellReference).Value.ToCharArray()
Array.Reverse(colLetters)
Dim convertedValue = Asc(colLetters(0)) - 65
For i = 1 To colLetters.Length - 1
Dim current = Asc(colLetters(i)) - 64
convertedValue += current * Math.Pow(26, i)
Next
Return convertedValue
End Function
with this function you can simulate empty cells:
Dim row As Row = SheetData.Descendants(Of Row)().FirstOrDefault(Function(y) y.RowIndex.Value = 2)
Dim cells = row.Descendants(Of Cell).ToDictionary(
Function(cell) ConvertCellReferenceToNumber(cell.CellReference),
function(cell) cell)
For i = 0 To cells.Keys.Max()
Dim c As Cell
If (cells.TryGetValue(i, c)) Then
Console.WriteLine(c.CellValue) 'need hanle for special values
Else
Console.WriteLine("empty")
End If
Next
I am not familiar with using macro's, but I think that what I would like excel to perform is best handled with a macro. So I can use all the input you may have!
I have these headers;
ID Tag Pen Sex Weight Class Inside range
With 450 rows of data. Based on the distribution of the weight data, I have in two other columns (class and number) the number of rows I want to select within each class. The selected rows must have the value "Yes" in the column "Inside range".
I want to randomly select the rows, based on the number needed for each class, and copy these rows to a new sheet. It sums up to 30 rows in the new sheet.
I hope you have a suggestion how to complete this action!
can you try the following, you will need to add a reference to Microsoft Scripting Runtime library:
Const rowCount = 450
Public Sub copyRows()
Dim i As Integer
Dim j As Integer
Dim classes As Scripting.Dictionary
Dim source As Worksheet
Dim colNumber As Integer
Dim colClassName as Integer
Dim colInsideRange As Integer
Dim allSelected As Boolean
Dim randomRow as Integer
Dim sumRemaining as Integer
allSelected = False
Set source = Worksheets("YourWorksheetName")
colClassName = 6 'this is the column number where class names are entered. I am assuming 6
colNumber = 7 'this is the column number where number of rows to be selected are entered. I am assuming 7
colInsideRange = 8 'this is the column number where "Inside Range" values are entered. I am assuming 9
For i = 2 to rowCount + 1 'assuming you have a header row
classes(CStr(source.Cells(i, colClassName))) = CInt(source.cells(i, colNumber)
Next i
Do until allSelected
Randomize
randomRow = Int ((Rnd * 450) + 2) 'assuming you have a header row, + 1 if you don't
If classes(CStr(source.Cells(randomRow, colClassName))) = 0 Then
With classes
sumRemaining = 0
For j = 1 to .Count - 1
sumRemaining = sumRemaining + .Items(j)
If sumRemaining > 0 Then Exit For
Next j
allSelected = (sumRemaining = 0)
End With
Else
source.Cells(randomRow, colInsideRange) = "Yes"
classes(CStr(source.Cells(randomRow, colClassName))) = classes(CStr(source.Cells(randomRow, colClassName))) - 1
End If
Loop
'Enter your code to copy rows with "Inside Range" = "Yes"
End Sub
Sorry if there are some errors or typos, I wrote from my mobile phone.