Loop Over Rows and Columns - excel

For the life of me, I can't figure out how to loop a formula over columns and down rows. I put some code together that I thought would be on the right track:
Sub LoopAcrossColsRows()
Dim C As Integer
Dim R As Integer
Dim LastCol As Integer
Dim LastRow As Long
Dim lr As Long
Worksheets("Sheet1").Activate
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, 20).End(xlUp).Row
lr = Cells(Rows.Count, 1).End(xlUp).Row
For C = 2 To LastCol
For R = lr + 3 To LastRow
.Cells(R, C).FormulaR1C1 = “=SUMPRODUCT(--(R6C:R7C>=RC1), --(R6C:R7C<=(RC1+30))*R4C)"
Next R
Next C
End Sub
The formula is causing an expected list separator or ) error. The formula works when I insert it on my worksheet, so I do not know what could be going wrong. Thanks for all help in advance.
As an aside, is there anyway to create an input box that would prompt for a new sheet name, which would be reflected as the new sheet name in the Worksheets("Sheet1").Activate line, so that I wouldn't have to keep changing the sheet name in the vba code?
Thanks again,

You need to qualify the Cells property with an object
Your error message from the VB interface is due to the fact that your first quote mark is a left double quote and not a regular quote mark.
Try
Cells(R, C).FormulaR1C1 = "=SUMPRODUCT(--(R6C:R7C>=RC1), --(R6C:R7C<=(RC1+30))*R4C)"
And better than looping would be a routine that assigns the formula to a multicell range object.
Not Tested:
range(cells(lr+3,2),cells(lastrow,lastcol)).FormulaR1C1 = "=SUMPRODUCT(--(R6C:R7C>=RC1), --(R6C:R7C<=(RC1+30))*R4C)"

The line
.Cells(R, C)...
should probably be qualified:
ActiveSheet.Cells(R,C)...
Better yet, you should retain a reference to the appropriate worksheet in a variable, instead of depending on it being the active sheet for the length of the For loop:
Dim wks As Worksheet
Set wks=Worksheets("Sheet1")
...
For R = lr + 3 To LastRow
wks.Cells(R, C).FormulaR1C1 = “=SUMPRODUCT(--(R6C:R7C>=RC1), --(R6C:R7C<=(RC1+30))*R4C)"
Next R
...
Your aside is an entirely separate question and doesn't belong here, but consider using the Excel Application.Inputbox function, or the VBA Inputbox function.

I believe you need the code to be
Activesheet.Cells(R,C)...
If you don't want to use name to call worksheets, then use index
worksheet(1).cells(x,y)...
however this is only useful if you never change the order of worksheet. Because worksheet(1) always goes to the first sheet of the workbook.
also you can set a variable as worksheet and use that
Dim ws1 As Worksheet
'or set it = Worksheet(1)
Set ws1 = Worksheets("sheet"1)
ws1.cells(1,1) = "test"
For the name problem you can try this
Dim yourName as String
yourName = Application.InputBox("Enter name of worksheet")
worksheet(1).Name = yourName

EDITED:
Ok, so took a detailed look at your code. There are a couple of changes to make here.
The loop for "R" doesn't get triggered because lr+3 will always > LastRow
C and R in "Cells(R,C)" could be problematic --> varR and varC.
.Cells --> Activesheet.Cells
You define your last row variable twice "LastRow" & "lr"? I'm not sure why. (also see #6 below.
RC reference in .FormulaR1C1 to be bound by []
The End(xl[Up, ToLeft]) method could miss the full size of the data set if it is not contiguous. "a1" can be replaced with different row/column ranges to constrain the variable. (Sorry for not knowing the source of this code, but have been using this for a while)
I'm not sure if the code will run seamless, or will loop exactly the range you need. But give it a go and see if it works. Hopefully the principle will guide you to a solution:
Sub LoopAcrossColsRows()
Dim varC As Integer
Dim varR As Integer
Dim LastCol As Integer
Dim LastRow As Long
Dim lr As Long
Worksheets("Sheet1").Activate
LastRow = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
LastCol = Cells.Find("*", [a1], , , xlByColumns, xlPrevious).Column
For varC = 2 To LastCol
For varR = (LastRow + 3) To LastRow Step -1
Worksheets("Sheet1").Cells(varR, varC).FormulaR1C1 = "=SUMPRODUCT(--(R6C:R7C1>=RC1),--(R6C:R7C1<=(RC1+30))*R4C)"
Next varR
Next varC
End Sub

Related

can someone help me make this formula work on an entire column?

im hoping that someone can help me to take a macro down an entire column.here is what i am trying to do.
the following table is in a worksheet called barcode. it is my master list. column E:E, is a helper column that has part numbers with countif numbers attach like so=:1,:2,:3, etc. i did this because i have multiple orders for part numbers that are due on different dates in the order report. in column c, there is a number of how many of a part has been ran. in column d, the number of parts that have been scrapped and would have to be ran again. i have highlighted a row to use as an example. in this case. part number ms-100 has a total of 1 part ran and zero scrapped.
the next sheet is my order report sheet. it displays what a customer has ordered of what part. the calculation that i want to have is: if ms-100:1 on the order report matches what is on the master list, then take the qty from the order report and subtract how many were ran, and add how many were scrapped. so for this case. if ms-100:1 =ms-100:1 then cell f8 =12-1+0.
my current code will do that, but it will only do the cells that i point them to and not the entire column. to make it easier to see if this code works or not, instead of changing the values of column f on the order report, i moved it to column l. the goal is to have the value change in f, but for now i was putting the value in l. as you can see, in L7, it says no order. i hope this clarifies what i am trying to accomplish. thank you very much. here is the code that i have so far. i was attempting to use for each cell but it doesnt seem to be working.
Sub FIND_MATCHES()
Dim sh1 As Worksheet
Dim sh4 As Worksheet
Set sh1 = ActiveWorkbook.Sheets("BARCODE")
Set sh4 = ActiveWorkbook.Sheets("ORDER REPORT")
Dim CELL As Range
Dim LASTROW As Long
Dim R As Long
Dim c As Range
Set c = sh4.Range("L:L")
LASTROW = sh4.CELLS(Rows.COUNT, 12).End(xlDown).Row
'LASTROW = Range("F7:F" & Rows.COUNT).End(xlUp).Row
Dim COMPID As Range
Set COMPID = sh1.Range("E:E").Find(What:=sh4.Range("N7").Value, LookIn:=xlValues, LOOKAT:=xlWhole)
'sh4.Range("L7:L" & LASTROW).Activate
'sh4.Range("L7:L" & LASTROW).Select
For Each CELL In c
If COMPID Is Nothing Then
sh4.Range("L7").Value = "NO ORDER"
Else
'TEST CELL'sh4.Range("L7").Value = COMPID.Offset(, -2).Value
sh4.Range("L7").Value = sh4.Range("F7").Value - COMPID.Offset(0, -2).Value + COMPID.Offset(0, -1).Value
'Range("L7:L" & LASTROW).Select
' Range("L8").Select
Exit For
End If
Next CELL
End Sub
I was able to find the solution myself. the below code is what i used. I thought i would share it just in case someone else had the same issue.
Sub FIND_MATCHES()
Dim barcode As Worksheet
Dim order As Worksheet
Set barcode = ActiveWorkbook.Sheets("BARCODE")
Set order = ActiveWorkbook.Sheets("ORDER REPORT")
Dim LASTROW As Long
Dim c As Long
Dim X As Integer
X = 1
Dim finalrow As String
finalrow = order.cells(Rows.COUNT, 12).End(xlUp).Row
Dim location As Range
Set location = barcode.cells.Item(X, "E")
Dim HELPER As String
Dim NUMROWS As String
NUMROWS = order.cells(Rows.COUNT, 14).End(xlUp).Row
HELPER = barcode.cells.Item(X, "E").Value
LASTROW = order.cells(Rows.COUNT, 14).End(xlUp).Row
Dim ENDROW As String
ENDROW = order.cells(Rows.COUNT, 4).End(xlUp).Row
For X = 1 To ENDROW
For c = 7 To NUMROWS
If order.cells(c, 14).Value = barcode.cells.Item(X, "E").Value Then
order.cells(c, 12).Value = order.cells(c, 6).Value - barcode.cells.Item(X, "E").OFFSET(0, -2).Value + barcode.cells.Item(X, "E").OFFSET(0, -1).Value
Else
ActiveCell.OFFSET(1, 0).Select
End If
Next c
Next X
order.Range("A2").Select
End Sub

Variable out of range or failed to be recognized

I need some advice for my code. I really appreciate if some members can edit my code. Thanks
My code below is looking for the name on column B and copy the result on another sheet if 2 conditions met:
- The row.value on column G = "ongoing"
- The row.value on column C = "HP"
When I run this code, got an error-message box "Range of Object"_Worksheet failed.
I am trying to change the set "mytable to ShSReturn.ListObject ("Survey Return")" with mytable as Range, another message error "Subscription out of range"
Sub LOf()
Dim cell As Variant
Dim myrange As Long, lastrow As Long, finalrow As Long, resultrow As Long
Dim mytable As Range
lastrow = ShSReturn.Range("G" & ShSReturn.Rows.Count).End(xlUp).Row
finalrow = ShSReturn.Range("C" & ShSReturn.Rows.Count).End(xlUp).Row
resultrow = ShSReturn.Range("B" & ShSReturn.Rows.Count).End(xlUp).Row
Set mytable = ShSReturn.ListObjects("Survey Return")
cell = 7
For Each cell In mytable
If mytable.Cells(cell, lastrow).Value = "Ongoing" _
And mytable.Cells(cell, finalrow).Value = "HP" Then
mytable.Cells(cell, resultrow).Copy
ShPPT.Cells(cell, 17).PasteSpecial xlPasteValues
resultrow = resultrow + 1
End If
Next cell
End Sub
I think there's some confusion about the nature of your ListObject, as specified in your original code (see comments to the question). When you select a bunch of cells and go to Insert -> Table, then as well as the table object, Excel defines a Range with the name of that table: a named Range. This Range may be referenced directly in VBA as such:
Set mytable = Range("Table1")
Note that Range names may not contain spaces
On the assumption that you have a named Range, it might be something like this:
Sub LOf()
Dim myrange As Long, lastrow As Long, finalrow As Long, resultrow As Long
Dim mytable As Range
lastrow = ShSReturn.Range("G" & ShSReturn.Rows.Count).End(xlUp).Row
finalrow = ShSReturn.Range("C" & ShSReturn.Rows.Count).End(xlUp).Row
resultrow = ShSReturn.Range("B" & ShSReturn.Rows.Count).End(xlUp).Row
Set mytable = ActiveSheet.Range("SurveyReturn") ' It's best to specify which sheet your source data is on. Presumably "ShSReturn" is the CodeName of your results sheet
Dim x As Long
For x = 7 To mytable.Cells(mytable.Cells.Count).Row ' Start at Row 7, and finish at the row number of the last cell in that Range
If mytable.Cells(x, **lastrow**).Value = "Ongoing" And mytable.Cells(x, **finalrow**).Value = "HP" Then
mytable.Cells(x, **resultrow**).Copy
ShPPT.Cells(cell, 17).PasteSpecial xlPasteValues
resultrow = resultrow + 1
End If
Next x
End Sub
Note that the above code will not work in its present form. What I have done is an approximation of what I think you're looking for: however you're going to have to do a bit of work, because the code in your question has some fundamental issues. For example, in your code you have lines like this:
mytable.Cells(cell, resultrow).Copy
However addressed cells within Ranges are in the format Range.Cells(Row, Column) - where Row and Column are numbers. However in your code resultrow as defined at the top is a Row, not a Column. You need to work out what exactly you want to copy, in terms of which row/column and re-write your code accordingly.
If you want to provide clarity, I'll be happy to edit my answer to accommodate what you want.

trouble declaring a variable as a specific cell on a worksheet

Very new to VBA. i am having trouble declaring a variable as a specific cell on a worksheet.
I have tried defining the cell by rows and columns but when I put a watch on the line it says Value is out of context. The variable is testname and it is in cell E2 of the worksheet I have set as the variable raw.
Sub findcomponents()
Dim raw As Worksheet
Dim res As Worksheet
Dim temp As Worksheet
Dim testname As String
Dim finalrow1 As Integer
Dim finalrow2 As Integer
Dim i As Integer
Set raw = Worksheets("rawdata")
Set res = Worksheets("resultcomponents")
Set temp = Worksheets("uploadtemplate")
testname = raw.Range("E2").Value
finalrow1 = raw.Range("A10000").End(xlUp).Row
finalrow2 = res.Range("A10000").End(xlUp).Row
For i = 2 To finalrow2
If res.Cells(i, 4) = testname Then
Range(Cells(i, 2), Cells(i, 4)).Copy
temp.Range("A10000").End(xlUp).Cells("A2").Paste
End If
Next i
End Sub
I expect the value to be the string in the E2 cell
Edit: I added the rest of the code. When I run it doesn't do anything.
It is supposed to take the string testname and loop through a list on the res worksheet and return the matches. I put a watch on the testname line because i thought it would show me that it was comparing the correct string and the Value in the watch line says
yes the paste line is incorrect. I also tried temp.Range("A10000").End(xlUp).Offset(1, 0).Paste and this makes it angry also.
The fix works with an edit on the worksheet name. But there is more than 1 match on the res worksheet. That is why I thought finding the the last row (but I should have offset 1 row) would return all the matches. This does work to return all values.
temp.Range("A10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Is there a better way to do this not using Range("A10000").End(xlUp)?
Your key problem is with the paste statement.
You can use one of the two following methods to paste (although it should be noted that there are others)
Range.Copy PasteRange
or
Range.Copy
PasteRange.PasteSpecial (paste type (values, formats, etc.))
This has also been updated with more standard variable blocks/variable names for Last Row calculations. Also, notice that I have also updated the Last Row calculation to be a little more dynamic. Lastly, swapping Integer for Long
Option Explicit
Sub findcomponents()
Dim raw As Worksheet: Set raw = ThisWorkbook.Sheets("rawdata")
Dim res As Worksheet: Set res = ThisWorkbook.Sheets("resultcomponents")
Dim temp As Worksheet: Set temp = ThisWorkbook.Sheets("uploadtemplate")
Dim testname As String
Dim LR1 As Long, LR2 As Long, LR3 As Long, i As Long
LR1 = raw.Range("A" & raw.Rows.Count).End(xlUp).Row '<-- This variable is never used??
LR2 = res.Range("A" & res.Rows.Count).End(xlUp).Row '<-- Updated for standard Last Row (LR) calculation
For i = 2 To LR2
If res.Cells(i, 4) = raw.Range("E2") Then
res.Range(res.Cells(i, 2), res.Cells(i, 4)).Copy '<-- Qaulified Ranges!!
LR3 = temp.Range("A" & temp.Rows.Count).End(xlUp).Offset(1).Row
temp.Range("A" & LR3).PasteSpecial xlPasteValues '<-- Correct Paste Method
End If
Next i
End Sub
The naming conventions used are just my preference. To an extent, you are free to name variables however you see fit

Why can my offset() not take variable?

I try to line up columns from each sheet into a summary sheet. The Columns nymber in each sheet can vary and each have to be lined up to each other. I try with the following code:
Sub Create_Summary()
Dim sh As Worksheet, sumSht As Worksheet
Dim i As Long
Dim colCount As Long
Dim rowCount As Long
Sheets("Summary").Cells.ClearContents
Set sumSht = Sheets("Summary")
sumSht.Move after:=Worksheets(Worksheets.Count)
For i = 1 To Worksheets.Count - 1
colCount = sumSht.Columns.Count
rowCount = Worksheets(i).Rows.Count
Worksheets(i).Range("A:VV").Copy Destination:=sumSht.Cells(1,
colCount).End(xlToLeft).Offset(, 1)
Next i
sumSht.Columns(2).Delete
End Sub
This doesn't work properly due to the .Offset(, 1) I guess... I dont understand why I am not allowed to use .Offset(, colCount) because then I think it would look good. For some reason if I use .Offset(, i) (which make no sense to do) it's just OK and it can run. Both is a Long variables, so what make the difference and how can I fix this?
Thanks in advance...
To make this dynamic, consider:
getting the range of the detail you want to move for each sheet and storing this in detailRowCount and detailColCount
keeping an track of the used columns in Summary worksheet by incrementing the value for the number of columns pasted in per detailColCount.
Example code:
Option Explicit
Sub Create_Summary()
Dim sh As Worksheet, sumSht As Worksheet
Dim i As Long
Dim detailColCount As Long
Dim detailRowCount As Long
Dim summaryColCount As Long
Sheets("Summary").Cells.ClearContents
Set sumSht = Sheets("Summary")
sumSht.Move after:=Worksheets(Worksheets.Count)
summaryColCount = 1
For i = 1 To Worksheets.Count - 1
Set sh = Worksheets(i)
detailColCount = sh.Cells(1, 1).End(xlToRight).Column
detailRowCount = sh.Cells(1, 1).End(xlDown).Row
sh.Range(sh.Cells(1, 1), sh.Cells(detailRowCount, detailColCount)).Copy _
Destination:=sumSht.Cells(1, summaryColCount)
summaryColCount = summaryColCount + detailColCount
Next i
'sumSht.Columns(2).Delete <-- ?
End Sub

Last row in column VBA

I wrote a short VBA code to automate stuff.
A short snippet is as follows:
Sub TEST()
Rows("1:2").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$O$148"), , xlYes).Name = _
"Table2"
End Sub
However, every Excel file differs with regards to the number of rows. Now when I recorded this macro it just takes the range of $A$1:$O$148. How can I adjust this part so that it automatically recognizes the last row and/or range?
I already tried:
.Range("A1").SpecialCells(xlCellTypeLastCell).Row
Instead of:
Range("$A$1:$O$148")
Thanks in advance!
Generally, you can find the last row / column and therefore the complete used range by using:
ActiveWorkbook.Worksheets("NAME").Range("A" & Rows.Count).End(xlUp).row
for the last row and
ActiveWorkbook.Worksheets("NAME").Cells(1, Columns.Count).End(xlToLeft).Column
for the last column.
I would advice against using UsedRange because if you have blanks in between, it will lead to mistakes.
This is the way I do it and I'm guessing this is a duplicate, but you can mimic hitting End-Up from a row well below your used range with
finalRow = Range("A65000").End(xlup).Row
then you can do
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$O$" & finalRow & ""), , xlYes).Name = _
"Table2"
You can use the UsedRange property of your worksheet-object.
You can get the indexes of your last used row and column using
ActiveSheet.UsedRange.Columns.Count
ActiveSheet.UsedRange.Rows.Count
So you would basically use this like
With m_Sheet
' Use this range
.Range(.UsedRange.Rows.Count, .UsedRange.Columns.Count)
End With
I used the shortcut Ctrl+Arrow Down, which resulted in following VBA (after recording the macro):
Selection.End(xlDown).Select
This will do the trick:
Dim rSource As Range
With Worksheets("Sheet1")
Set rSource = .Range("A1", .Columns("A:O").Find(What:="*", After:=.Range("A1"), SearchDirection:=xlPrevious))
End With
This would help if you don't know much of the vba library or syntax like me.
Dim lastline as long
Dim lastColumnline as long
dim usedcells as long
dim i as long
dim YOURCOLUMN as long
dim count as long
Set ws = Worksheet("blablabla")
lastline = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
usedcells = Application.WorksheetFunction.CountA(ws.Columns(YOURCOLUMN))
for i = 1 to lastline
if ws.cells(i,YOURCOLUMN) <> vbnullstring then
count = count + 1
if count = usedcells then
lastColumnline = i
'i is the lastColumnline
end if
end if
next i
This is how I locate last row:
Function lastRow(Optional strSheet As String, Optional column_to_check As Long = 1) As Long
Dim shSheet As Worksheet
If strSheet = vbNullString Then
Set shSheet = ActiveSheet
Else
Set shSheet = Worksheets(strSheet)
End If
lastRow = shSheet.Cells(shSheet.Rows.Count, column_to_check).End(xlUp).Row
End Function
The column is optional, if no value is given, it is column A.
My GitHub repository with LastThings is here.

Resources