I want to read and store values from 4*4 matrix(2 dimensional array) and use it in my further program. I am talking about VBA for Excel. Data is in Excel sheet and I want to read it through VBA. I am new to this, but learning fast. Please help me doing it.
this is my data in sheet
a 2 5 6
b 6 8 7
c 3 6 9
this is what I want to do
a 0 2 7 13
b 0 6 14 21
c 0 3 9 18
I need to read 3*3 matrix from sheet and transform it to cumulative matrix as shown. (add the previous number and go on).
Basically I am simulating a Markov Chain and needs to count how many times a person go through each stage.
Sub example7()
Dim A As Double, B As Double, C As Double, PC(4, 4) As Double, row As Double, maxrwo As Double, col As Double, maxcol As Double
Range("o5").Activate
For i = 1 To 4
For j = 1 To 4
PC(i, j) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Next j
ActiveCell.Offset(1, -4).Select
Next i
Range("T4") = PC(2, 4)
End Sub
If you want to process values in a range you don't need to store them in an array first. You could loop through each cell in the range by using code similar to the below:
Sub LoopThroughRange()
Dim currentCell As Range
Dim desiredRange As Range
Dim outputCell As Range
Dim total As Double
Set outputCell = Range("A6")
Set desiredRange = Range("Sheet1!A1:D4")
'This will add the values of each cell in the range and output the total to cell A6
For Each currentCell In desiredRange
total = total + currentCell.Value
Next currentCell
outputCell.Value = total
End Sub
Related
Suppose that I have Excel file consists of four worksheets, lets name them as 1, 2, 3 and 4. I want to evaluate a sum of all values from the cells AK10, AK25, AK40 and so on till AK160 on the worksheet 4 and then place it in the cell G23 of worksheet 2.
Here is my macro that I assign to worksheet 2:
Sub sum_up()
Dim i As Integer, s As Integer
s = 0
For i = 0 To 10
s = WorksheetFunction.Sum(s, Worksheets("4").Range("AK(10 + 15 * i)"))
Next i
Range("G23").Value = "s"
End Sub
It ends up with 400 error. What am I doing wrong?
Sub sum_up()
Dim i As Long, s As Long
s = 0
For i = 0 To 10
s = s + Worksheets("4").Cells(10 + 15 * i, "AK").Value
Next i
Range("G23").Value = s
End Sub
I'll take a crack at this - I'd really use a lot more named ranged to pass data back and forth...:
Sub sum_up()
Dim i As Integer, s As Integer
s = 0
For i = 0 To 10
s = s + Worksheets("4").Range("AK" & (10 + 15 * i))
Next I
Range("G23").Value = s
End Sub
you did not say that the summation was to be done using VBA
put this in G23 on worksheet2 (actually, put this in any cell)
=SUM('4'!AK10,'4'!AK25,'4'!AK40,'4'!AK55,'4'!AK70,'4'!AK85,'4'!AK100,'4'!AK115,'4'!AK130,'4'!AK145,'4'!AK160)
as far as what you are doing wrong with your code, that has partly been answered by #KenWhite
you are also putting the letter "s" into G23 of any worksheet that happens to be visible at the time your code runs
put in a reference to sheet 2, same as you referenced sheet 4 just two lines above
this code should work:
Sub sum_up()
Dim ws4 As Worksheet
Set ws4 = ActiveWorkbook.Sheets("4")
Dim rng As Range
Set rng = ws4.Range("ak10") ' point to "ak10"
Dim total As Long
total = rng.Value
Do While True
rng.Select
Set rng = rng.Offset(15) ' move pointer down 15 rows
If rng.Row > 160 Then Exit Do ' moved past row 160 ?
total = total + rng.Value
Loop
ActiveWorkbook.Sheets("2").Range("G23").Value = total
End Sub
Amt1 Tax1 Amt2 Tax2 Amt3 Tax3 Amt4 Tax4 Amt5 Tax5 Amt6 Tax6
YQ 25 YR 22 QW 25 TR 58 WR 105 AY 125
YR 102 YQ 25 AY 15 YR 152 WR 55 WQ 120
In Excel, now i want the output in a column for total of YR, if YR comes 5 times in a row the output should give me total of all 5.
can anyone help me with this?
Formula based solution using SUMIFS
=SUMIFS(B2:L2,A2:K2,"YR")
Notice the offset in the ranges: Sum Range is offset 1 column to right of Criteria Range
Welcome to StackOverflow. This is not a code-for-me site and when you ask such questions you should show some kind of effort for solving them.
Having said that, here is a way to solve your problem with a custom formula:
Option Explicit
Public Function OutputMe(rngSelectRange As Range, strOutput As String) As Double
Dim rngCell As Range
For Each rngCell In rngSelectRange
If rngCell = strOutput Then
OutputMe = OutputMe + rngCell.Offset(0, 1).Value
End If
Next rngCell
End Function
You can use the UDF below:
Option Explicit
Function mySumIfs(lRow As Long, Str As String) As Long
Dim LastCol As Long
Dim C As Range
LastCol = Cells(lRow, Columns.Count).End(xlToLeft).Column ' get last column in current row
' loop through all cells in the Range of the Row selected
For Each C In Range(Cells(lRow, 1), Cells(lRow, LastCol))
If C.Value Like Str Then
mySumIfs = mySumIfs + C.Offset(, 1).Value
End If
Next C
End Function
Then, in your Excel Sheet's cell you can just type in the Formula:
=mySumIfs(3,"YR").
3 - indicating the row number
"YR" - the string being searched for
You can also use it from VBA, just use:
Dim SumTest As Long
SumTest = mySumIfs(3, "YR")
Screen-shot of how it is implemented in my Excel Sheet:
I'm new to VBA (somewhat) and I was assigned the tedious task of searching over 5000 rows to highlight rows (from A to j with the colorindex=6) based on a cell value and it's taking me forever. Basically I'm trying to develop a program that searches a string under column C, if the cell is equal to the string searched, then offset to 4 row below from the active cell and for any number greater than 37 and stops when it finds a cell in a row with the index color 33. Any ideas? I started and now stuck. Any ideas will help. Thanks
Sub Priority()
'Declaring all worksheets in the excel file
Dim US As Worksheet
Dim Venr50 As Worksheet
Dim Priority As Worksheet
Dim CBT As String
'setting all variables declared
Set US = Worksheets("US CKS")
Set Venr = Worksheets("VENR50 US 09.24")
Set Priority = Worksheets("Priority")
CBT = Priority.Range("$C$6").Value
With US
Dim x As Long
For x = 4 To 3000
If Cells(x, "C").Value = CBT Then
ActiveCell.Interior.ColorIndex = 33
ActiveCell.Offset(4, 0).Select
End If
You can do another loop within your For loop like below:
Dim x As Long
Dim j as integer
For x = 4 To 3000
If Cells(x, "C").Value = CBT Then
For j=1 to 4
If Cells(x+j,"C").Value>37 then Cells(x+j,"C").ColorIndex = 6
If Cells(x+j,"C").Interior.ColorIndex = 33 then exit sub
Next j
End If
If Cells(x+j,"C").Interior.ColorIndex = 33 Then Exit Sub
Next x
EDIT:
To change the color index of multiple rows you can use:
Range(Cells(x+j,"A"),Cells(x+j,"J")).Interior.ColorIndex = 6
I want to write "1" in a specified number of cells in column E, and then "2" in the same number of cells directly below the cells with 1 in them, and then "3", and so on, until the value I'm writing in the cells reaches a user-defined variable. I think I should be using a For...Next loop for this, but I'm not sure. The code I have now is this:
Dim k As Long
For k = 0 To observations
Range(Cells(2 + (k * patientprofiles), 5), Cells(1 + p * (k + 1), 5)).Value = k + 1
Next
where observations is the value that I want to write in the cells, and patientprofiles is the number of cells to fill before moving to the next value. For example, if observations is 6 and patientprofiles is 40, I want to write 1 in cells E2:E41, 2 in cells E42:E81, 3 in cells E82:E121, 4 in cells E122:E161, 5 in cells E162:E201 and 6 in cells E202:E241.
The code I have above is writing 7 in cells E1:E242, i.e., it's not changing the value it's writing as it moves through the loop, and it's starting in E1 and finishing in E242 instead of starting in E2 and finishing in E241.
I have three questions about this:
Am I correct in thinking that I should be using a For...Next loop to do this? If not, what should I be using?
If For...Next is the right approach, how can I get VBA to write a different value in each of the cells, rather than the same one in all cells?
Why is it starting a cell too high and ending a cell too low?
Thank you for your help and I apologize if this is a really simple question or if it has been answered elsewhere.
You want the .Resize() method in conjunction with the Step argument for a loop:
Sub Foo()
Dim k As Long
Dim incrementValue As Long
Const observations As Long = 6
Const patientProfiles As Long = 40
incrementValue = 1
For k = 2 To observations * patientProfiles Step patientProfiles
Cells(k, 5).Resize(40, 1).Value = incrementValue
incrementValue = incrementValue + 1
Next
End Sub
The Step argument tells the loop to increment in steps, for example:
For i = 1 To 10 '// 1,2,3,4,5,6,7,8,9,10
For i = 1 To 10 Step 2 '// 1,3,5,7,9
For i = 1 To 10 Step 3 '// 1,4,7,10
The Resize() method re-sizes a range object to the given parameters:
Range("A1") '// 1R x 1C
Range("A1:B5") '// 5R x 2C
Range("A1").Resize(5, 2) '// 5R x 2C (Now "A1:B5")
Range("B5").Resize(9, 1) '// 9R x 1C (Now "B5:B13")
Another way as below
Sub testttt()
Dim k As Long
observations = 6
patientprofiles = 40
For k = 0 To observations
Range("E" & (Range("E" & Rows.Count).End(xlUp).Row + 1), "E" & patientprofiles + (Range("E" & Rows.Count).End(xlUp).Row)).Value = k
Next
End Sub
a "formula" approach
Option Explicit
Sub main()
Dim observations As Long, patientprofiles As Long
observations = 6
patientprofiles = 10
ActiveSheet.Range("e2").Resize(observations * patientprofiles).FormulaR1C1 = "=IF(ROWS(R2C:RC)=1,1,IF(COUNTIF(R2C:R[-1]C,R[-1]C)<" & observations & ",R[-1]C,R[-1]C+1))"
End Sub
which could be also written directly in excel cells with the only care to limit the cells where to put it into or add to the formula an outer "IF" condition to count the number of rows where to write the resulting number
I want to copy contents of one row in Excel to other row.
Currently, I am using following code for copying data from previous row.
rngCurrent.Offset(-1).Copy
rngCurrent.PasteSpecial (xlPasteValues)
but I want to skip some columns. So let's say if there are 20 columns, I want to copy all columns except column 4 and 14. How can this be achieved in VBA?
Example:
Assume following is the data in row.
Row to be copied........> 1 2 3 4 5 6 7 8 .... 14 15 16
Target Row Before Copy..> A B C D E F G H .... N O P
Target Row After Copy...> 1 2 3 D 5 6 7 8 .... N 15 16
So everything is copied except column 4 and 14. Note that original values D and N in column 4 and 14 of Target row are preserved.
Sam
I am not sure exactly how you want to use the macro (i.e. do you select range in sheet, or single cell?) but the following code may get you started:
EDIT - code updated to reflect your comments. I have added a function to check if the columns you want to keep are in the array.
Sub SelectiveCopy()
'Set range based on selected range in worksheet
Dim rngCurrent As Range
Set rngCurrent = Selection
'Define the columns you don't want to copy - here, columns 4 and 14
Dim RemoveColsIndex As Variant
RemoveColsIndex = Array(4, 14)
'Loop through copied range and check if column is in array
Dim iArray As Long
Dim iCell As Long
For iCell = 1 To rngCurrent.Cells.Count
If Not IsInArray(RemoveColsIndex, iCell) Then
rngCurrent.Cells(iCell).Value = rngCurrent.Cells(iCell).Offset(-1, 0)
End If
Next iCell
End Sub
Function IsInArray(MyArr As Variant, valueToCheck As Long) As Boolean
Dim iArray As Long
For iArray = LBound(MyArr) To UBound(MyArr)
If valueToCheck = MyArr(iArray) Then
IsInArray = True
Exit Function
End If
Next iArray
InArray = False
End Function
Depending on what you want to do you could augment this code. For example, rather then selecting the range you want to copy, you could click any cell in the row and then use the following to select the EntireRow and then perform the copy operation:
Set rngCurrent = Selection.EntireRow
Hope this helps
Try using union of 2 ranges:
Union(Range("Range1"), Range("Range2"))
Another way of doing it.....takes less no. of loops.
Assumptions
1. Skip columns are in ascending order.
2. Skip columns value starts from 1 and not 0.
3. Range("Source") is First cell in source data.
4. Range("Target") is First cell in target data.
Sub SelectiveCopy(rngSource As Range, rngTarget As Range, intTotalColumns As Integer, skipColumnsArray As Variant)
If UBound(skipColumnsArray) = -1 Then
rngSource.Resize(1, intTotalColumns).Copy
rngTarget.PasteSpecial (xlPasteValues)
Else
Dim skipColumn As Variant
Dim currentColumn As Integer
currentColumn = 0
For Each skipColumn In skipColumnsArray
If skipColumn - currentColumn > 1 Then 'Number of colums to copy is Nonzero.'
rngSource.Offset(0, currentColumn).Resize(1, skipColumn - currentColumn - 1).Copy
rngTarget.Offset(0, currentColumn).PasteSpecial (xlPasteValues)
End If
currentColumn = skipColumn
Next
If intTotalColumns - currentColumn > 0 Then
rngSource.Offset(0, currentColumn).Resize(1, intTotalColumns - currentColumn).Copy
rngTarget.Offset(0, currentColumn).PasteSpecial (xlPasteValues)
End If
End If
Application.CutCopyMode = False
End Sub
How to call :
SelectiveCopy Range("Source"), Range("Target"), 20, Array(1) 'Skip 1st column'
SelectiveCopy Range("Source"), Range("Target"), 20, Array(4,5,6) 'Skip 4,5,6th column'
SelectiveCopy Range("Source"), Range("Target"), 20, Array() 'Dont skip any column. Copy all.
Thanks.