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))"
Related
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
I am trying to create VBA code that copies and pastes data from Column B into the row directly beneath in Column A. I do not have great experience with VBA and so I am struggling to create such a code.
I would like to create a code that loops for an entire set of data in Columns A and B as shown in the attached picture.
So for example, B3 would get pasted into A4. B5 would get pasted into A6. And all the way down until the list was completed.
Thank you for any help!
The below code works quite good for your criteria.
rowNum = 3
Do While Trim(Range("A" & rowNum).Value) <> ""
Range("A" & (rowNum + 1)).Value = Range("B" & rowNum).Value
rowNum = rowNum + 2
Loop
Here is a simple example that will do what you ask.
For i = 2 To 10
If Range("A" & i) > "" And Range("A" & i + 1) = "" Then
Range("B" & i).Cut
Range("A" & i + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
End If
Next
Depending on what your data looks like, you will probably want to setup something more dynamic for the value of 'i'.
Use LastRowIndex from https://stackoverflow.com/a/71296/42346 to find the final row then iterate over the rows in column 2 placing the value in column 1 one row below the current row.
Sub iterate()
Dim r As Long
Dim c As Long
Dim endrow As Long
c = 2
endrow = LastRowIndex(ActiveSheet, c)
For r = 2 To endrow Step 1
If ActiveSheet.Cells(r, c).Value <> "" Then
ActiveSheet.Cells(r + 1, c - 1).Value = ActiveSheet.Cells(r, c).Value
End If
Next r
End Sub
Function LastRowIndex(ByVal w As Worksheet, ByVal col As Variant) As Long
Dim r As Range
Set r = Application.Intersect(w.UsedRange, w.Columns(col))
If Not r Is Nothing Then
Set r = r.Cells(r.Cells.Count)
If IsEmpty(r.Value) Then
LastRowIndex = r.End(xlUp).Row
Else
LastRowIndex = r.Row
End If
End If
End Function
Ok this is what I tried with:
Sheets("ProDiver ored").Range("X" & i).Value = Sheets("ProDiver ored").Range("W2:W" + i).Value
But it doesn't work.
What I am trying to do is to make the macro take the W1:Wx and summarize these on the X column.
It should be looking like this in other words:
X1 = W1
X2 = W1 + W2
X3 = W1 + W2 + W3
X4 = W1 + W2 + W3 + W4
And so on.
Can you guys direct me on how to do this? I want it for a VBA Excel macro of course.
As Siddharth suggested (and slightly changed from the comment):
This will paste the formula from X1 down to the bottom of the data range:
Sub JustFormula()
With ThisWorkbook.Worksheets("Sheet1")
.Range(.Cells(1, 24), .Cells(Rows.Count, 23).End(xlUp).Offset(, 1)).Formula = "=SUM($W$1:$W1)"
End With
End Sub
A slight change to the procedure and you can have just the values instead:
Sub JustValues()
Dim MyRange As Range
With ThisWorkbook.Worksheets("Sheet1")
Set MyRange = .Range(.Cells(1, 24), .Cells(Rows.Count, 23).End(xlUp).Offset(, 1))
End With
MyRange.Formula = "=SUM($W$1:$W1)"
MyRange.Value = MyRange.Value
End Sub
If your workbook takes a while to calculate you may want to put a DoEvents before the .Value = .Value line.
Try
Sheets("ProDiver ored").Range("X" & i).Value = Application.Sum(Sheets("ProDiver ored").Range("W1:W" & i))
above assumes you do not need the formula to add values up just the result of the calculation
If you want to have all sub parts of the concatenation like in your example, you should have a loop: (untested!)
Dim cell As Object
Dim j As Integer
Dim newString As String
Set newString = ""
Set j = 0
For cell in Sheets("ProDiver ored").Range("W:W") 'entire column W
newString = newString + cell.Value
Range("X" & j).Value = newString
j = j + 1
Next
Try with this. I already tested it. It work well.
Public Sub summarizeValue()
Dim row As Integer
Dim summarize As Integer
Dim dataSheet As Worksheet
'Set start row
row = 1
'Getting data sheet
Set dataSheet = ThisWorkbook.Worksheets("sheetname")
'We need some break point, so I used "Do While" instead of "For" which is looping all cell.
'Loop column cells until blank
Do While dataSheet.Range("W" & row) <> ""
'If adding integer, use "+" sign
'If adding string, use "&" sign
summarize = summarize + dataSheet.Range("W" & row)
'Set summarize value into result cell
dataSheet.Range("X" & row) = summarize
'Increase row
row = row + 1
Loop
End Sub
I have 3 issues with the following piece of code:
Intention of code: I have a table of data, 4 columns (F,G, H and I) wide and X rows long (X is typically between 5 and 400). I have a list of dates in column M, typically no more than 8 dates. Column H of table, contains dates as well. I want to find the dates that are in both columns (H and M) and whenever they appear, go to the same row in column I and set its value to zero, and the one after it (so if a match was in H100, then I100 and I101 would be zeroed).
issues with code: edited 1) as per feedback.
1) I have, using an if formula (=if(H100=M12,1,0), verified that there is one match, as how the spreadsheet sees it. The macro does not find this match, despite confirmation from the if formula. Cells I100 and I101 have nonzero values, when they should be zeroed.
2) the code runs, but takes about 3 minutes to go through 3 sheets of 180 rows of data. What can be done to make it run faster and more efficiently? It could have up to 30 sheets of data, and 400 rows (extreme example but possible, in this instance im happy to let it run a bit).
3) Assuming my data table before the macro is run, is 100 rows long, starting in row 12, after the macro, column I has nonzero values for 111 rows, and zeroes for the next 389. Is there a way I can prevent it from filling down zeroes, and leaving it blank?
I am using a correlate function afterwards on column I and there huge agreement of 0's with 0's is distorting this significantly. Thanks in advance,
Sub DeleteCells()
Dim ws As Worksheet
Dim cell As Range, search_cell As Range
Dim i As Long
Dim h As Long
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Cover" Then
For Each cell In ws.Range("H12:H500")
On Error Resume Next
h = ws.Range("G" & Rows.Count).End(xlUp).Row
i = ws.Range("L" & Rows.Count).End(xlUp).Row
Set search_cell = ws.Range("M12:M" & h).Find(what:=cell.Value, LookIn:=xlValues, lookat:=xlWhole)
On Error GoTo 0
If Not search_cell Is Nothing Then
ws.Range("I" & cell.Row).Value = 0
ws.Range("I" & cell.Row + 1).Value = 0
Set search_cell = Nothing
End If
Next cell
End If
Next ws
Application.ScreenUpdating = True
Set ws = Nothing: Set cell = Nothing: Set search_cell = Nothing
End Sub
EDIT: TESTED CODE, will work for 0, 1 row of data in H/M column starting from row 12?
EDIT: Updated the cell to handle case with 1 line of data, untested :|
I will give my solution first, this one should be much faster because it read the cells into memory first
Please comment if it doesn't work or you have further question
Sub DeleteCells()
Dim ws As Worksheet
Dim i As Long
Dim h As Long
Dim MColumn As Variant ' for convinence
Dim HColumn As Variant
Dim IColumn As Variant
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Cover" Then 'matching the target sheet
' matching the rows where column M's date matches column H's date
'starting row num is 12
With ws ' for simplifying the code
h = .Range("H" & .Rows.count).End(xlUp).Row
If h = 12 Then ' CASE for 1 row only
If Range("H12").Value = Range("M12").Value Then
Range("I12:I13").Value = ""
End If
ElseIf h < 12 Then
' do nothing
Else
ReDim HColumn(1 To h - 11, 1 To 1)
ReDim MColumn(1 To h - 11, 1 To 1)
ReDim IColumn(1 To h - 10, 1 To 1)
' copying the data from worksheet into 2D arrays
HColumn = .Range("H12:H" & h).Value
MColumn = .Range("M12:M" & h).Value
IColumn = .Range("I12:I" & h + 1).Value
For i = LBound(HColumn, 1) To UBound(HColumn, 1)
If Not IsEmpty(HColumn(i, 1)) And Not IsEmpty(MColumn(i, 1)) Then
If HColumn(i, 1) = MColumn(i, 1) Then
IColumn(i, 1) = ""
IColumn(i + 1, 1) = ""
End If
End If
Next i
'assigning back to worksheet cells
.Range("H12:H" & h).Value = HColumn
.Range("M12:M" & h).Value = MColumn
.Range("I12:I" & h + 1).Value = IColumn
End If
End With
End If
Next ws
Application.ScreenUpdating = True
End Sub
OK, I have a simple problem that I need help with in a VBA Macro. I have an excel sheet that looks like this...
Product # Count
101 1
102 1
101 2
102 2
107 7
101 4
101 4
189 9
I need a macro that adds up the "count" column based on the Product Number Column. I want it to over all look like this after I am done...
Product # Count
101 7
102 7
107 7
189 9
I am an amiture to VBA so I would love any help I can get.
Assuming the data is in columns A and B, you can do it with a formula:
=SUMIF(A:A,101,B:B)
Or if you put 101 in C1:
=SUMIF(A:A,C1,B:B)
EDIT
However if you still require VBA, here is my (quick and dirty) proposal - I use a dictionary to keep track of the sum for each item.
Sub doIt()
Dim data As Variant
Dim i As Long
Dim countDict As Variant
Dim category As Variant
Dim value As Variant
Set countDict = CreateObject("Scripting.Dictionary")
data = ActiveSheet.UsedRange 'Assumes data is in columns A/B
'Populate the dictionary: key = category / Item = count
For i = LBound(data, 1) To UBound(data, 1)
category = data(i, 1)
value = data(i, 2)
If countDict.exists(category) Then
countDict(category) = countDict(category) + value 'if we have already seen that category, add to the total
Else
countDict(category) = value 'first time we find that category, create it
End If
Next i
'Copy dictionary into an array
ReDim data(1 To countDict.Count, 1 To 2) As Variant
Dim d As Variant
i = 1
For Each d In countDict
data(i, 1) = d
data(i, 2) = countDict(d)
i = i + 1
Next d
'Puts the result back in the sheet in column D/E, including headers
With ActiveSheet
.Range("D1").Resize(UBound(data, 1), UBound(data, 2)) = data
End With
End Sub
The easiest thing is to use a Pivot Table in this case as Tim suggested.
Here is a VBA solution that uses multidimensional arrays. I noticed you said you are a bit new to VBA so I tried to put some meaningful comments in there. One thing that might look strange is when I redimension the arrays. That's because when you have multidimensional arrays you can only ReDim the last dimension in the array when you use the Preserve keyword.
Here is how my data looked:
Product Count
101 1
102 1
101 2
102 2
107 7
101 4
101 4
189 9
And here is the code. It has the same output as my last answer. Test this in a new workbook and put the test data in Sheet1 with headers.
Option Explicit
Sub testFunction()
Dim rng As Excel.Range
Dim arrProducts() As String
Dim i As Long
Set rng = Sheet1.Range("A2:A9")
arrProducts = getSumOfCountArray(rng)
Sheet2.Range("A1:B1").Value = Array("Product", "Sum of Count")
' go through array and output to Sheet2
For i = 0 To UBound(arrProducts, 2)
Sheet2.Cells(i + 2, "A").Value = arrProducts(0, i)
Sheet2.Cells(i + 2, "B").Value = arrProducts(1, i)
Next
End Sub
' Pass in the range of the products
Function getSumOfCountArray(ByRef rngProduct As Excel.Range) As String()
Dim arrProducts() As String
Dim i As Long, j As Long
Dim index As Long
ReDim arrProducts(1, 0)
For j = 1 To rngProduct.Rows.Count
index = getProductIndex(arrProducts, rngProduct.Cells(j, 1).Value)
If (index = -1) Then
' create value in array
ReDim Preserve arrProducts(1, i)
arrProducts(0, i) = rngProduct.Cells(j, 1).Value ' product name
arrProducts(1, i) = rngProduct.Cells(j, 2).Value ' count value
i = i + 1
Else
' value found, add to id
arrProducts(1, index) = arrProducts(1, index) + rngProduct.Cells(j, 2).Value
End If
Next
getSumOfCountArray = arrProducts
End Function
Function getProductIndex(ByRef arrProducts() As String, ByRef strSearch As String) As Long
' returns the index of the array if found
Dim i As Long
For i = 0 To UBound(arrProducts, 2)
If (arrProducts(0, i) = strSearch) Then
getProductIndex = i
Exit Function
End If
Next
' not found
getProductIndex = -1
End Function
Sub BestWaytoDoIt()
Dim i As Long ' Loop Counter
Dim int_DestRwCntr As Integer ' Dest. sheet Counter
Dim dic_UniquePrd As Scripting.Dictionary
Set dic_UniquePrd = New Scripting.Dictionary
For i = 2 To Sheet1.Range("A" & Sheet1.Cells.Rows.Count - 1).End(xlUp).Row
If dic_UniquePrd.exist(Sheet1.Range("A" & i).Value) <> True Then
dic_UniquePrd.Add Sheet1.Range("A" & i).Value, DestRwCntr
sheet2.Range("A" & int_DestRwCntr).Value = Sheet1.Range("A" & i).Value
sheet2.Range("B" & int_DestRwCntr).Value = Sheet1.Range("B" & i).Value
Else
sheet2.Range("A" & dic_UniquePrd.Item(Sheet1.Range("A" & i).Value)).Value = sheet2.Range("B" & dic_UniquePrd.Item(Sheet1.Range("A" & i).Value)).Value + Sheet1.Range("B" & i).Value
End If
Next
End Sub
This will serve the purpose..
Only thing to remember is to activate "Microsoft Scripting Runtimes" in references.
Based the code in Sub doIt(), is possible in the for Each ycle to retrive also the number of occurence?
Example:
Product # 101 have 4 occurence
Product # 102 have 2 occurence
ecc...
I know it' late... but I've been brought here by Sum up column B based on colum C values and so I post a solution with the same "formula" approach I used there but adapted to this actual need
Option Explicit
Sub main()
With ActiveSheet
With .Range("A:B").Resize(.cells(.Rows.Count, 1).End(xlUp).row) '<== here adjust "A:B" to whatever colums range you need
With .Offset(1).Resize(.Rows.Count - 1)
.Offset(, .Columns.Count).Resize(, 1).FormulaR1C1 = "=SUMIF(C1,RC1,C2)" ' "helper" column: it's the 1st column right of data columns (since ".Offset(, .Columns.Count)")
.Columns(2).Value = .Offset(, .Columns.Count).Resize(, 1).Value 'update "count" with sum-up from "helper" column
With .Offset(, .Columns.Count).Resize(, 1) ' reference to "helper" column
.FormulaR1C1 = "=IF(countIF(R1C1:RC1,RC1)=1,1,"""")" ' locate Product# repetition with blank cells
.Value = .Value 'fix values
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'delete rows corresponding to blank cells
.ClearContents ' clear "helper" column
End With
End With
End With
End With
End Sub
it makes use of a "helper" columns, which I assumed could be the one adjacent to the last data columns (i.e.: if data columns are "A:B" then helper column is "C")
should different "helper" column be needed then see comments about how it's located and change code accordingly