As a beginner, I would like to ask if it is possible in VBA to autofill formulas in a multidimensional array.
Ι thought and wrote this code and it works with values but not with formulas.
I think that what I am trying to do is very ambitious for my skills
Sub eucldiist()
Dim e(10,10) As Double, i As Integer, j As Integer
For i = 1 To 10
For j = 1 To 10
e(i, j).FormulaArray = "=sqrt((offset('Data1'!$Q$14,$BD$5(offset(i)) -
offset('Data1'!$Q$14,$BD$5(offset(j))^2+ ((offset('Data1'!$U$14,
$BD$5(offset(i))-OFFSET('Data1'!$U$14,$BD$5(offset(j)))^2)"
Next j
Next i
Sheets("Calculations").Select: Range("A20").Select
For i = 1 To 10
For j = 1 To 10
ActiveCell.Value = e(i, j)
ActiveCell.Offset(0, 1).Select
Next j
ActiveCell.Offset(1, -10).Select
Next i
End Sub
Is it possible what I am trying to do?
check this out. put some formulas in a20:j29 before hand
Option Explicit
Sub test()
Dim aaa As Variant
aaa = Range("a20").Resize(10, 10).Formula
Stop ' now examine aaa in "locals" window
' maybe all you want is this
range("a20").Resize(10,10).FormulaArray = "=SQRT((OFFSET(DATA1!Q14,BD5,0)-OFFSET(DATA1!Q14,BD7,0))^2+((OFFSET(DATA1!U14,BD5,0)-OFFSET(DATA1!U14,BD7,0))^2))"
End Sub
i think that this is what you want
NOTE: formula uses absolute addressing, so a column or row insert will break it
delete $ from formula to make it use relative addressing
Sub eucldiist()
Dim base As Range
Set base = Sheets("Calculations").Range("A20")
' Set base = ActiveSheet.Range("A20")
Dim formula As String
Dim i As Integer, j As Integer
For i = 0 To 9 ' rows
For j = 0 To 9 ' columns
formula = "=sqrt(" _
& " (offset('Data1'!$Q$14,$BD$" & 5 + i & ",0) - offset('Data1'!$Q$14,$BD$" & 7 + j & ",0))^2" _
& " + (offset('Data1'!$U$14,$BD$" & 5 + i & ",0) - offset('Data1'!$U$14,$BD$" & 7 + j & ",0))^2" _
& ")"
' Debug.Print formula
base.Offset(i, j) = formula
Next j
Next i
End Sub
Related
I am using VBA to write a Macro and it is working exactly as I want, except that I would like my formulas to loop through the sheets instead of using data on 'SAFO-1', 'SAFO-1' refers to the fish Salvelinus fontinalis (SAFO). I have many fish species (e.g., Morone saxatilis (MOSA)) and it would be way more pratical if I could refer to the sheet number instead of their name. Unfortunately, I do not decide sheet names and they have to stay as they are because we're working on shared projects with unique name for every samples. Sheets name change between projects and I want to be able to use my code in all of them. Here is my current code:
Sub Mean()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Sheet As Integer
k = 4
i = Application.Sheets.Count
For Sheet = 2 To i
Worksheets(Sheet).Select
j = 3
Do While ActiveCell.Value <> "0"
Range("A" & j).Select
If ActiveCell.Value = "0" Then
Range("A1").Copy
Worksheets("Mean").Range("A" & Sheet + 1).PasteSpecial Paste:=xlPasteValues
Worksheets("Mean").Range("B" & Sheet + 1).Formula = "=(('SAFO-1'!B80)-('SAFO-1'!B75))"
Worksheets("Mean").Range("C" & Sheet + 1).Formula = "=(('SAFO-1'!C80)-('SAFO-1'!C75))"
For k = 4 To 41
Worksheets("Mean").Cells(Sheet + 1, k).FormulaR1C1 = "=AVERAGE('SAFO-1'!R" & j + 10 & "C" & k & ":R" & j - 9 & "C" & k & ")"
Next k
Else
j = j + 1
End If
Loop
Next Sheet
Range("B1:AP2").Copy Worksheets("Mean").Range("A1")
Worksheets("Mean").Select
End Sub
My idea is to replace 'SAFO-1' by 'Sheet1', to be enventually able to write something like :
Worksheets("Mean").Cells(Sheet + 1, k).FormulaR1C1 = "=AVERAGE('Sheet "& Sheet")'!R" & j + 10 & "C" & k & ":R" & j - 9 & "C" & k & ")"
Thanks in advance!
William Fortin
First, we are going to stop using .Select and instead use object handles. I'm not entirely sure where the name of your sheet comes from but I'm going to assume that it's related to the loop and use that as an example. We get an object handle on the sheet using it's number Set currentSheet = Worksheets(Sheet) and then we can grab it's name and use that where we need to in the formula currentSheet.Name.
I hope that even if this code isn't a complete solution that it shows you how to get where you are going.
Option Explicit
Public Sub Mean()
Dim j As Long
Dim k As Long
Dim Sheet As Long
k = 4
For Sheet = 2 To Application.Sheets.Count
Dim currentSheet As Worksheet
Set currentSheet = Worksheets(Sheet)
j = 3
Do
Dim currentCell As Range
Set currentCell = currentSheet.Range("A" & j)
If currentCell.Value = "0" Then
With Worksheets("Mean")
.Range("A" & Sheet + 1).Value = currentSheet.Range("A1").Value
.Range("B" & Sheet + 1).Formula = "=(('" & currentSheet.Name & "'!B80)-('" & currentSheet.Name & "'!B75))"
.Range("C" & Sheet + 1).Formula = "=(('" & currentSheet.Name & "'!C80)-('" & currentSheet.Name & "'!C75))"
For k = 4 To 41
.Cells(Sheet + 1, k).FormulaR1C1 = "=AVERAGE('" & currentSheet.Name & "'!R" & j + 10 & "C" & k & ":R" & j - 9 & "C" & k & ")"
Next k
End With
Else
j = j + 1
End If
Loop While currentCell.Value <> "0"
Next Sheet
currentSheet.Range("B1:AP2").Copy Worksheets("Mean").Range("A1")
Worksheets("Mean").Select
End Sub
We can create an array of worksheet names in VBA and use them to create the formulas we put in the sheets. For example:
Sub useNumber()
sh = Array("big worksheet name", "collosal worksheet name", "mammoth worksheet name", "tiny worksheet name")
Sheets("Sheet1").Range("A1").Formula = "=SUM('" & sh(1) & "'!A3:A6)"
End Sub
If you have many sheets, use a For loop to fill the array rather than the Array() function.
running this creates:
=SUM('collosal worksheet name'!A3:A6)
In Sheet1 cell A1
This approach makes looping over data sheets easier:
Sub useNumberloop()
sh = Array("big worksheet name", "collosal worksheet name", "mammoth worksheet name", "tiny worksheet name")
For i = 1 To 4
Sheets("Sheet1").Range("A" & i).Formula = "=SUM('" & sh(i - 1) & "'!A3:A6)"
Next i
End Sub
I am trying to Index/Match data only when a certain criteria is met.
I could do this with two arrays but I'm hoping there's an easy answer here.
My code is as follows:
Sub Nozeroleftbehind(lengthRow As Integer)
For i = 2 To lengthRow
If Cells(1, i) = 0 Then Cells(1, i) = "TBD"
Next i
For i = 2 To lengthRow
If Cells(1, i) = "#N/A" Then
Cells(2, i) = "=INDEX(Forecast!L:L,MATCH('AA - Inbound Orders Weekly Rep'!H113,Forecast!A:A,0))"
End if
Next i
End Sub
And then pass that sub back to the main routine.
What I am trying to get dynamic is that 'H113' cell. I can't seem to get an offset to work properly since it's already in a formula.
EDIT: Apologies, H113 moves down. Next cell would be H114.
Regards
Please try this code.
Sub NoZeroLeftBehind(lengthRow As Integer)
' 18 Oct 2017
Dim lengthRow As Long
Dim Tmp As Variant
Dim C As Long
lengthRow = 4
For C = 2 To lengthRow
' bear in mind that the Cell is a Range
' and you want to refer to its Value & Formula property
With Cells(1, C)
Tmp = .Value
' using the Val() function will interpret a blank cell as zero value
If Val(Tmp) = 0 Then
.Value = "TBD"
ElseIf IsError(Tmp) Then
.Formula = "=INDEX(Forecast!L:L,MATCH('AA - Inbound Orders Weekly Rep'!H" & _
(113 + C - 2) & ",Forecast!A:A,0))"
End If
End With
Next C
End Sub
Knowing that you want to go H113, H114:
Cells(2, i) = "=INDEX(Forecast!L:L,MATCH('AA - Inbound Orders Weekly Rep'!H" & CStr(111 + i) & ",Forecast!A:A,0))"
I have to create a Macro which lets me Concatenate two columns at a time in a given range. For example: In range C1:Z200, I want to concatenate Column C&D, E&F, G&H and so on. How do I do it. This is my current code which only concatenate first two columns..rest remains the same.
Set Range = ActiveSheet.Range("C1:Z100")
For Each c In Range
c.Select
ActiveCell.FormulaR1C1 = ActiveCell & " " & ActiveCell.Offset(0, 1)
ActiveCell.Offset(0, 1).Activate
Selection.Clear
ActiveCell.Offset(0, 2).Activate
Next c
Try this:
Sub Concat()
Dim i As Long, j As Long
For i = 1 To 100 'number of rows
j = 1 'reset column to 1
Do While j < 25 'max number of columns (until Column Y-Z)
j = j + 2 'start from third column (Column C)
Cells(i, j) = Cells(i, j) & " " & Cells(i, j + 1) 'concat
Cells(i, j + 1).ClearContents 'clear
Loop
Next i 'next row
End Sub
Try this:
Sub ConcatAltCellsInAltCols()
Dim oW As Worksheet: Set oW = ThisWorkbook.Worksheets("Sheet11")
Dim iLC As Long: iLC = oW.Cells(1, oW.Columns.Count).End(xlToLeft).Column
Dim iLR As Long: iLR = oW.Cells(oW.Rows.Count, 3).End(xlUp).Row
Dim iC As Long
Dim iR As Long
For iR = 1 To iLR
For iC = 3 To iLC Step 2
oW.Cells(iR, iC).Value = oW.Cells(iR, iC) & oW.Cells(iR, iC + 1)
Next
Next
End Sub
Try this using a one based array for better Performance:
Code
Option Explicit
Sub Conc()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Concat") ' <== change "Concat" to your sheet name to avoid subscript error
Dim v ' variant
Dim lng As Long
Dim j As Integer ' corr.
' use one based array to get field data
v = ws.Range("C1:Z100") ' your OP range
For lng = 1 To UBound(v)
' concatenate columns C&D, E&F, G&H, ...
For j = 0 To 11
v(lng, j * 2 + 1) = v(lng, j * 2 + 1) & v(lng, j * 2 + 2)
Next j
Next lng
' write array values back (overwriting D, F, H,... with the same values)
ws.Range("C1:Z100") = v ' your OP range
End Sub
So at Assign sheet I indicate the sheets to take data for each group (each for column and the first row is the explanation of the group). I dynamically can add res at the file or delete
After I use predefined codes to assign which type of discounts / day are applied. At the example I only put two codes (C and S) and one week. For example the raw sheet data for designations Red and Black.
Data product worksheet
Then at Diary I want to show the result of concatenate the B1 value (name of product) each time code fromm price are indicated into the rows. Also I use two loop because at raw product data I have one column for price but at the Diary I have two
Summary page
This is what I finally want to get and doing like that because my boss don't know anything for code and he wan't edite it so I try to do ll dynamic at the sheets :) [I only put two images because i don't have reputations point enough to put more]
With the formula I only get FALSE as answer :(, and I need to get what you can see at summary page
Sub Diary()
Dim I As Integer, x As Integer, y As Integer, z As Integer, n As Integer
Dim p As Integer, d As Integer, f As Integer
Dim a As String, b As String
Dim element As Variant
' Initialize variables I and y at 3 and 4 to begin to show the data at the column I desire. Also x and z were intended to pass the one column mode data sheet to the two column mode at the summary page.
I = 3
x = 1
y = 4
z = 0
With Worksheets("Asign")
.Activate
.Range("B2").Select
End With
' Set the size of Data with sheet names it get form the page assign. It can dynamically changed as size as names of sheets
With ActiveSheet
r = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Dim Data() As String
ReDim Data(r)
For p = 1 To r - 1
Data(p) = ActiveSheet.Cells(p + 1, "B").Value
Next p
With Worksheets("Diary")
.Activate
.Range("C7").Select
End With
' At Diary concatenate the same cell for all the sheets I have his name stored at Data() and then pass to the next cell with data at raw data sheets (in the images (Red, Black ,... pages). In this case search for code S
Do
Cells(7, I).Select
ActiveCell.Value = ActiveCell.FormulaR1C1 = "=CONCATENATE(" & a & ")"
For Each element In Data
b = ActiveCell.FormulaR1C1 = "IF(Data& !R[-2]C[" & x & "]=""S"",CONCATENATE(Data&!R1C2,"", ""),"""")"
a = b & ";" & b
Next element
x = x - 1
I = I + 2
Loop While I < 4
' The same for the second column of summary sheet called Diary. In this case search for code C
Do
Cells(7, y).Select
ActiveCell.Value = ActiveCell.FormulaR1C1 = _
"=CONCATENATE(" & a & ")"
For Each element In Data
b = ActiveCell.FormulaR1C1 = "IF(Data& !R[-2]C[" & z & "]=""S"",CONCATENATE(Data&!R1C2,"", ""),"""")"
a = b & ";" & b
Next element
z = z - 1
y = y + 2
Loop While I < 4
' Drag and Drop the formula to all the sheet's cells you need
Range("C8:E8").Select
Selection.AutoFill Destination:=Range("C8:E10"), Type:=xlFillDefault
'
End Sub
try this. .... could be simplified by looping through "colors" .... black, red, etc
Sub Diary()
Dim red As Variant
red = Sheets("red").Range("d6:g12") ' put range data into an array for processing
Dim black As Variant
black = Sheets("black").Range("d6:g12")
Dim i As Integer
Dim j As Integer
Dim strC As String
Dim strS As String
For i = 1 To 7
For j = 1 To 4
strC = ""
strS = ""
If LCase(black(i, j)) = "c" Then strC = "Black"
If LCase(black(i, j)) = "s" Then strS = "Black"
If LCase(red(i, j)) = "c" Then
If Len(strC) > 1 Then strC = strC & ";"
strC = strC & "Red"
End If
If LCase(red(i, j)) = "s" Then
If Len(strS) > 1 Then strS = strS & ";"
strS = strS & "Red"
End If
Sheets("diary").Range("c7").Cells(i, j * 2 - 1) = strS
Sheets("diary").Range("c7").Cells(i, j * 2) = strC
Next j
Next i
End Sub
Simple question, yet I can't get it to work. I simply need to sum 2 sets of cells and paste the totals in a different column.
For example, I need to add the time value G4 and time value in G14 and paste the sum in B25. This should loop down to G10+G20 and paste into B31.
I know how easy it is with a simple excel function, but I need it in VBA terms, and ideally in a loop, not the recorder version of code.
Range("B25") = "=SUM(" & Range(G4, G14) & ")"
Try this:
Sub AddValues()
Dim i As Integer
Dim j As Integer
Dim k As Integer
j = 4
k = 14
For i = 25 To 31
Range("B" & i) = "=SUM(G" & j & ",G" & k & ")"
j = j + 1
k = k + 1
Next i
End Sub
Edit: Thanks #Steve for the hint