I'm stuck inserting a for loop inside a For function. Essentially, the script is supposed to search for the strings in the array and then paste it in D38 and paste the value of the next string into the next cell by increments of 3 (As seen by the For x = 38 To 100 Step 3). The issue I have is that the Next x is skipping the next value of the string and the loop gets stuck. I tried inserting the For x = 38 To 100 Step 3 inside the Else statement of the first for loop but it doesn't work. What else can I do to fix this? Thank you!
strings = Array("String 1", "String 2")
For Each strng In strings
strSearch = strng
For x = 38 To 100 Step 3
Worksheets("Paste Results Here").Activate
With ActiveSheet.Columns("D:D")
Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=True)
If rFind Is Nothing Then
MsgBox ("There is no " & strSearch)
Exit Sub
Else
rFind.Activate
ActiveCell.Offset(0, 5).Resize(3, 1).Copy
Worksheets("Data").Activate
Set rng = Worksheets("Data").Cells(x, 4)
rng.Activate
ActiveCell.PasteSpecial xlValues
End If
End With
Next x
Next strng
I believe this is what you're trying to do, but let me know if it isn't. Get rid of the inner loop all together and only increment x by 3 when the string is found.
strings = Array("String 1", "String 2")
x = 38
For Each strng In strings
strSearch = strng
Worksheets("Paste Results Here").Activate
With ActiveSheet.Columns("D:D")
Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=True)
If rFind Is Nothing Then
MsgBox ("There is no " & strSearch)
Exit Sub
Else
rFind.Offset(0, 5).Resize(3, 1).Copy
Worksheets("Data").Activate
Set rng = Worksheets("Data").Cells(x, 4)
rng.PasteSpecial xlValues
x = x + 3
End If
End With
Next strng
Exit Sub bails out of the procedure scope entirely.
You don't want that - you want to bail out of the inner loop, but keep iterating to perform the next search.
Exit For will do that.
If rFind Is Nothing Then
MsgBox ("There is no " & strSearch)
Exit For
Not clear what your conditions are, but it sounds like you also want to Exit For when you do have a match. Now, if you bail out of a loop whether or not you've found what you're looking for, reconsider whether you need an inner loop at all.
Or, search for each search-string for each value of x instead of searching for each value of x for every search-string, as Scott suggested ("flip the loops"):
For x = 38 To 100 Step 3
For Each strng In strings
Set rFind = Range.Find...
If Not rFind Is Nothing Then
...paste special...
Else
...msgbox
End If
Next
Next
Use Exit For to exit a loop body, and Exit Sub to exit the procedure completely.
Related
How can I find the last row that contains data in a specific column and on a specific sheet?
How about:
Function GetLastRow(strSheet, strColumn) As Long
Dim MyRange As Range
Set MyRange = Worksheets(strSheet).Range(strColumn & "1")
GetLastRow = Cells(Rows.Count, MyRange.Column).End(xlUp).Row
End Function
Regarding a comment, this will return the row number of the last cell even when only a single cell in the last row has data:
Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
You should use the .End(xlup) but instead of using 65536 you might want to use:
sheetvar.Rows.Count
That way it works for Excel 2007 which I believe has more than 65536 rows
Simple and quick:
Dim lastRow as long
Range("A1").select
lastRow = Cells.Find("*",SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row
Example use:
cells(lastRow,1)="Ultima Linha, Last Row. Youpi!!!!"
'or
Range("A" & lastRow).Value = "FIM, THE END"
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
Usage:
? LastRowIndex(ActiveSheet, 5)
? LastRowIndex(ActiveSheet, "AI")
Public Function LastData(rCol As Range) As Range
Set LastData = rCol.Find("*", rCol.Cells(1), , , , xlPrevious)
End Function
Usage: ?lastdata(activecell.EntireColumn).Address
All the solutions relying on built-in behaviors (like .Find and .End) have limitations that are not well-documented (see my other answer for details).
I needed something that:
Finds the last non-empty cell (i.e. that has any formula or value, even if it's an empty string) in a specific column
Relies on primitives with well-defined behavior
Works reliably with autofilters and user modifications
Runs as fast as possible on 10,000 rows (to be run in a Worksheet_Change handler without feeling sluggish)
...with performance not falling off a cliff with accidental data or formatting put at the very end of the sheet (at ~1M rows)
The solution below:
Uses UsedRange to find the upper bound for the row number (to make the search for the true "last row" fast in the common case where it's close to the end of the used range);
Goes backwards to find the row with data in the given column;
...using VBA arrays to avoid accessing each row individually (in case there are many rows in the UsedRange we need to skip)
(No tests, sorry)
' Returns the 1-based row number of the last row having a non-empty value in the given column (0 if the whole column is empty)
Private Function getLastNonblankRowInColumn(ws As Worksheet, colNo As Integer) As Long
' Force Excel to recalculate the "last cell" (the one you land on after CTRL+END) / "used range"
' and get the index of the row containing the "last cell". This is reasonably fast (~1 ms/10000 rows of a used range)
Dim lastRow As Long: lastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row - 1 ' 0-based
' Since the "last cell" is not necessarily the one we're looking for (it may be in a different column, have some
' formatting applied but no value, etc), we loop backward from the last row towards the top of the sheet).
Dim wholeRng As Range: Set wholeRng = ws.Columns(colNo)
' Since accessing cells one by one is slower than reading a block of cells into a VBA array and looping through the array,
' we process in chunks of increasing size, starting with 1 cell and doubling the size on each iteration, until MAX_CHUNK_SIZE is reached.
' In pathological cases where Excel thinks all the ~1M rows are in the used range, this will take around 100ms.
' Yet in a normal case where one of the few last rows contains the cell we're looking for, we don't read too many cells.
Const MAX_CHUNK_SIZE = 2 ^ 10 ' (using large chunks gives no performance advantage, but uses more memory)
Dim chunkSize As Long: chunkSize = 1
Dim startOffset As Long: startOffset = lastRow + 1 ' 0-based
Do ' Loop invariant: startOffset>=0 and all rows after startOffset are blank (i.e. wholeRng.Rows(i+1) for i>=startOffset)
startOffset = IIf(startOffset - chunkSize >= 0, startOffset - chunkSize, 0)
' Fill `vals(1 To chunkSize, 1 To 1)` with column's rows indexed `[startOffset+1 .. startOffset+chunkSize]` (1-based, inclusive)
Dim chunkRng As Range: Set chunkRng = wholeRng.Resize(chunkSize).Offset(startOffset)
Dim vals() As Variant
If chunkSize > 1 Then
vals = chunkRng.Value2
Else ' reading a 1-cell range requires special handling <http://www.cpearson.com/excel/ArraysAndRanges.aspx>
ReDim vals(1 To 1, 1 To 1)
vals(1, 1) = chunkRng.Value2
End If
Dim i As Long
For i = UBound(vals, 1) To LBound(vals, 1) Step -1
If Not IsEmpty(vals(i, 1)) Then
getLastNonblankRowInColumn = startOffset + i
Exit Function
End If
Next i
If chunkSize < MAX_CHUNK_SIZE Then chunkSize = chunkSize * 2
Loop While startOffset > 0
getLastNonblankRowInColumn = 0
End Function
Here's a solution for finding the last row, last column, or last cell. It addresses the A1 R1C1 Reference Style dilemma for the column it finds. Wish I could give credit, but can't find/remember where I got it from, so "Thanks!" to whoever it was that posted the original code somewhere out there.
Sub Macro1
Sheets("Sheet1").Select
MsgBox "The last row found is: " & Last(1, ActiveSheet.Cells)
MsgBox "The last column (R1C1) found is: " & Last(2, ActiveSheet.Cells)
MsgBox "The last cell found is: " & Last(3, ActiveSheet.Cells)
MsgBox "The last column (A1) found is: " & Last(4, ActiveSheet.Cells)
End Sub
Function Last(choice As Integer, rng As Range)
' 1 = last row
' 2 = last column (R1C1)
' 3 = last cell
' 4 = last column (A1)
Dim lrw As Long
Dim lcol As Integer
Select Case choice
Case 1:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
Case 2:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Case 3:
On Error Resume Next
lrw = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lcol = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Last = Cells(lrw, lcol).Address(False, False)
If Err.Number > 0 Then
Last = rng.Cells(1).Address(False, False)
Err.Clear
End If
On Error GoTo 0
Case 4:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Last = R1C1converter("R1C" & Last, 1)
For i = 1 To Len(Last)
s = Mid(Last, i, 1)
If Not s Like "#" Then s1 = s1 & s
Next i
Last = s1
End Select
End Function
Function R1C1converter(Address As String, Optional R1C1_output As Integer, Optional RefCell As Range) As String
'Converts input address to either A1 or R1C1 style reference relative to RefCell
'If R1C1_output is xlR1C1, then result is R1C1 style reference.
'If R1C1_output is xlA1 (or missing), then return A1 style reference.
'If RefCell is missing, then the address is relative to the active cell
'If there is an error in conversion, the function returns the input Address string
Dim x As Variant
If RefCell Is Nothing Then Set RefCell = ActiveCell
If R1C1_output = xlR1C1 Then
x = Application.ConvertFormula(Address, xlA1, xlR1C1, , RefCell) 'Convert A1 to R1C1
Else
x = Application.ConvertFormula(Address, xlR1C1, xlA1, , RefCell) 'Convert R1C1 to A1
End If
If IsError(x) Then
R1C1converter = Address
Else
'If input address is A1 reference and A1 is requested output, then Application.ConvertFormula
'surrounds the address in single quotes.
If Right(x, 1) = "'" Then
R1C1converter = Mid(x, 2, Len(x) - 2)
Else
x = Application.Substitute(x, "$", "")
R1C1converter = x
End If
End If
End Function
I would like to add one more reliable way using UsedRange to find the last used row:
lastRow = Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count - 1
Similarly to find the last used column you can see this
Result in Immediate Window:
?Sheet1.UsedRange.Row+Sheet1.UsedRange.Rows.Count-1
21
Public Function GetLastRow(ByVal SheetName As String) As Integer
Dim sht As Worksheet
Dim FirstUsedRow As Integer 'the first row of UsedRange
Dim UsedRows As Integer ' number of rows used
Set sht = Sheets(SheetName)
''UsedRange.Rows.Count for the empty sheet is 1
UsedRows = sht.UsedRange.Rows.Count
FirstUsedRow = sht.UsedRange.Row
GetLastRow = FirstUsedRow + UsedRows - 1
Set sht = Nothing
End Function
sheet.UsedRange.Rows.Count: retrurn number of rows used, not include empty row above the first row used
if row 1 is empty, and the last used row is 10, UsedRange.Rows.Count will return 9, not 10.
This function calculate the first row number of UsedRange plus number of UsedRange rows.
Last_Row = Range("A1").End(xlDown).Row
Just to verify, let's say you want to print the row number of the last row with the data in cell C1.
Range("C1").Select
Last_Row = Range("A1").End(xlDown).Row
ActiveCell.FormulaR1C1 = Last_Row
get last non-empty row using binary search
returns correct value event though there are hidden values
may returns incorrect value if there are empty cells before last non-empty cells (e.g. row 5 is empty, but row 10 is last non-empty row)
Function getLastRow(col As String, ws As Worksheet) As Long
Dim lastNonEmptyRow As Long
lastNonEmptyRow = 1
Dim lastEmptyRow As Long
lastEmptyRow = ws.Rows.Count + 1
Dim nextTestedRow As Long
Do While (lastEmptyRow - lastNonEmptyRow > 1)
nextTestedRow = Application.WorksheetFunction.Ceiling _
(lastNonEmptyRow + (lastEmptyRow - lastNonEmptyRow) / 2, 1)
If (IsEmpty(ws.Range(col & nextTestedRow))) Then
lastEmptyRow = nextTestedRow
Else
lastNonEmptyRow = nextTestedRow
End If
Loop
getLastRow = lastNonEmptyRow
End Function
Function LastRow(rng As Range) As Long
Dim iRowN As Long
Dim iRowI As Long
Dim iColN As Integer
Dim iColI As Integer
iRowN = 0
iColN = rng.Columns.count
For iColI = 1 To iColN
iRowI = rng.Columns(iColI).Offset(65536 - rng.Row, 0).End(xlUp).Row
If iRowI > iRowN Then iRowN = iRowI
Next
LastRow = iRowN
End Function
Sub test()
MsgBox Worksheets("sheet_name").Range("A65536").End(xlUp).Row
End Sub
This is looking for a value in column A because of "A65536".
The first line moves the cursor to the last non-empty row in the column. The second line prints that columns row.
Selection.End(xlDown).Select
MsgBox(ActiveCell.Row)
I am trying to run a program that allows me to see what rooms in a college are free at a certain time in Microsoft excel.
The problem I am having is after I identify a empty class slot :
how doIi code it to go back up into the names of all the class rooms (All names are at Row 2)
and store the value of this.
I have tried offsetting but that wouldn't work for me.
I have added the Sample Data for further clarification
Public Sub EXq3()
Dim rnR1 As Range, roomNum As Integer
Const rooms = 13 ' Counter amount
Set rgR1 = ActiveCell.Offset(0, 1)
timeSolt = InputBox("What time") ' asks user what time to enter
Cells.find(What:=timeSolt, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate ' search and find code
For counter = 1 To rooms
If rgR1.Value = "" Then roomNum = rgR1.Offset(Range(2, rgR1.Value)) ' attempt at getting it to go to range 2
rgR1.Activate
Set rgR1 = rgR1.Offset(0, 1)
Next counter
MsgBox roomNum
End Sub
You probably by "go to range 2" mean "go to row 2", am I right? If yes, this is your solution:
For counter = 1 To rooms
If rgR1.Value = "" Then
roomNum = Cells(2, rgR1.Column).Value
End If
rgR1.Activate
Set rgR1 = rgR1.Offset(0, 1)
Next counter
EDIT
Ok, so I assume that you have some time options in column A, and some values for Room 1 in column B, Room 2 in column C etc. I have refactored your code to get rid of moving active cell. It is finding some time in column A and checking if there are some empty cells in row with this time option, and returns messages with numbers of this rooms.
My test sheet:
Code:
Public Sub EXq3()
Dim rnR1 As Range, roomNum As String, rooms As Integer Dim timeSolt As String
rooms = 13 ' Counter amount timeSolt = InputBox("What time") ' asks user what time to enter
Set rnR1 = ActiveSheet.Columns("A:A").Find(What:=timeSolt, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) ' search and find code
If rnR1 Is Nothing Then
MsgBox "Something is wrong with Input."
Else
For col = 2 To rooms + 1
If Cells(rnR1.Row, col).Value = "" Then
roomNum = Cells(2, col).Value
MsgBox roomNum
End If
Next col
End If
End Sub
So, i. e. when you type 17 in pop-up window, the result would be "Room 4" and "Room 10".
There is no need to Set rgR1 = ActiveCell.Offset(0, 1) , you can just search for the TimeSlot entered at the InputBox throughout your worksheet.
Also, it's better to stay away from Activate and ActiveCell and instead use referenced Ranges.
Since there is a possibility you have a few available room for a certain time, you need to store it as an array, and raise the index of rooms found on every match of ="".
There are more explanations inside the code comments below.
Code
Option Explicit
Public Sub EXq3()
Dim rnR1 As Range, roomNum As Variant, TimeSlot
Dim FindRng As Range, i As Integer, Counter As Integer
Const rooms = 13 ' Counter amount
ReDim roomNum(1 To 1000) ' init Rooms avaialable array to a large size
i = 1 '<-- reset Rooms Array index
TimeSlot = InputBox("What time") ' asks user what time to enter
Set FindRng = Cells.Find(What:=TimeSlot, After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False) ' search and find TimeSlot
If Not FindRng Is Nothing Then '<-- was able to find the timeslot in the worksheet
For Counter = 1 To rooms
If Cells(FindRng.Row, Counter + 1).Value = "" Then '<-- add 1 to counter since starting from Column B
roomNum(i) = Cells(2, Counter + 1).Value '<-- save room number inside the array
i = i + 1
End If
Next Counter
ReDim Preserve roomNum(1 To i - 1) ' <-- resize array back to number of available rooms found
' loop through all available rooms in the array, and show a msgbox for each one
For i = 1 To UBound(roomNum)
MsgBox "Room number " & roomNum(i) & " is available at " & TimeSlot
Next i
Else '<-- could bot find the timeslot in the worksheet
MsgBox "Couldn't find " & TimeSlot & " inside the worksheet!"
End If
End Sub
you could try this:
Public Sub EXq3()
Dim rnR1 As Range
Dim rooms As Integer
Dim timeSolt As String, roomNum As String
rooms = 13 ' Counter amount
With ActiveSheet
Do
timeSolt = Application.InputBox("What time", "Input time", Type:=2)
If timeSolt = CStr(False) Then Exit Sub '<--| exit if user cancels the dialogbox
Set rnR1 = .Columns("A:A").SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues).Find(What:=timeSolt, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) ' search and find code
If Not rnR1 Is Nothing Then Exit Do
MsgBox timeSolt & " is not a vaild time" & vbCrLf & vbCrLf & "please try again"
Loop
With .Range(rnR1.Offset(, 1), .Cells(rnR1.Row, .Columns.count).End(xlToLeft))
If WorksheetFunction.CountBlank(.Cells) = 0 Then
MsgBox "Sorry! No rooms left for the input time"
Else
roomNum = .Parent.Cells(2, .SpecialCells(xlCellTypeBlanks).Cells(1, 1).Column)
MsgBox "First room available at " & timeSolt & " is room " & roomNum
End If
End With
End With
End Sub
I have a code where there could be an instance of "Apple - Total", but it is very rare, while there will always be an instance of "Apple". How could I create a code to check whether the string exists in a row? The problem is at the moment is that the code bugs out if it is not there. If there is an instance of "Apple - Total" it should take priority over just "Apple". Something like the Try function in R would work.
If WorksheetFunction.Match(Apple & "-Total", Sheets("SOFP").Range("2:2"), 0) > 0 Then
letr = WorksheetFunction.Match(Fund & "-Total", Sheets("SOFP").Range("2:2"), 0)
letr = Split(Cells(, letr).Address, "$")(1)
cur = Sheets("SOFP").Offset(1, 0).Value
ElseIf WorksheetFunction.Match(Apple , Sheets("SOFP").Range("2:2"), 0) > 0 Then
letr = WorksheetFunction.Match(Fund, Sheets("SOFP").Range("2:2"), 0)
letr = Split(Cells(, letr).Address, "$")(1)
cur = Trim(Sheets("SOFP").Offset(1, 0).Value)
End If
Since:
it's always better :
avoid On Error Resume Next approach
which is quite dangerous and should be limited to a very few cases (like to check for any collection element)
use Match() function of the Application object instead of WorksheetFunction object
because it traps the error into its return value and hence doesn't stop code execution upon possible Match() failure
assuming:
you want to store into cur the value in the row beneath the proper column
"Apple" and "Fund" are two String literals and not String variables
a first approach, following more closely yours, could be the following:
Option Explicit
Sub main()
Dim letr As Variant
Dim cur As Double
With Sheets("SOFP").Range("2:2") '<-- reference your worksheet row 2
If Not IsError(Application.Match("Apple-Total", .Cells, 0)) Then '<-- if there's "Apple-Total"...
letr = Application.Match("Fund-Total", .Cells, 0) '<-- ...then try finding "Fund-Total"
ElseIf Not IsError(Application.Match("Apple", .Cells, 0)) Then '<-- otherwise if there's "Apple"...
letr = Application.Match("Fund", .Cells, 0) '<-- ...then try finding "Fund"
End If
If Not IsError(letr) Then '<-- if the "proper Fund" has been succesfully found...
letr = Split(Cells(, letr).Address, "$")(1) '<-- ...then get "proper Fund" column
cur = Trim(.Range(letr & "2").Value) '<-- and return the value in the 3rd row (i.e. with a row index of 2 with reference to row "2")
End If
End With
End Sub
But you may want to consider the following "Find()" approach:
Option Explicit
Sub main2()
Dim f As Range
Dim cur As Double
With Sheets("SOFP").Range("2:2") '<-- reference your worksheet row 2
If Not .Find(what:="Apple-Total", LookIn:=xlValues, lookAt:=xlWhole, MatchCase:=False) Is Nothing Then '<-- if "Apple-Total" has been found ...
Set f = .Find(what:="Fund-Total", LookIn:=xlValues, lookAt:=xlWhole, MatchCase:=False) '<-- ...then try finding "Fund-Total"
ElseIf Not .Find(what:="Apple", LookIn:=xlValues, lookAt:=xlWhole, MatchCase:=False) Is Nothing Then '<-- otherwise, if "Apple" has been found ...
Set f = .Find(what:="Fund", LookIn:=xlValues, lookAt:=xlWhole, MatchCase:=False) '<-- ...then try finding "Fund"
End If
If Not f Is Nothing Then cur = Trim(f.Offset(1).Value) '<-- if the "proper Fund" has been succesfully found then store the value in row 3 of its corresponding column
End With
End Sub
which I think is much neater
You could also use:
If iserror(application.match)... and handle it that way
On error goto TryApple
' try for total and goto eHandle if found
TryApple:
On error goto eHandle
' try for Apple
eHandle:
The first try for total is like the Try, TryApple is like catch, and eHandle is default
For context:
I would like for the program to look through column B, identify the first "< / >" (which is purely stylistic and can be changed if necessary - it's only used to break up the data) as the start of a week at cell B9 and the next "< / >" (end of the week) at B16. So the range I'm interested in is B10-B15. It would then sum those numbers from J10 to J15 (Earned column) and paste that sum in L16 (Week Total column). The same could then be done with 'Hours' and 'Week Hours'. For the following week (and thereafter) the 'end of the week' "< / >" becomes the start of the week, and the program continues until B200.
I don't have any experience with VBA and so made the following incomplete attempt (based on what I had found online) but felt too out of my depth not to ask for help.
Sub Work()
Dim rng As Range
Dim rngFound As Range
Set rng = Range("B:B")
Set rngFound = rng.Find("</>")
If rngFound Is "</>" Then
If Cell = "</>" Then
End If
End Sub
Thank you for any help and please let me know if I can be clearer or elaborate on something.
The following code will loop through 200 lines, looking for your symbol. When found, it will sum the numbers in column J for rows between the current row and the last symbol.
I've included two lines that will update the formula. To me, the 2nd one is easier to understand.
Sub Work()
Dim row As Integer
row = 4
Dim topRowToAdd As Integer 'Remember which row is the
'top of the next sum
topRowToAdd = 4
While row <= 200
If Cells(row, 2) = "</>" Then
'Cells(row, 10).FormulaR1C1 = "=SUM(R[" & -(row - topRowToAdd) & "]C[0]:R[" & -1 & "]C[0])"
Cells(row, 10).Value = "=SUM(J" & topRowToAdd & ":J" & row - 1 & ")"
topRowToAdd = row + 1
End If
row = row + 1
Wend
End Sub
Sub Work()
Dim rng As Range, rngFound As Range
Set rng = Range("B:B")
Set rngFound = rng.Find("</>")
If rngFound.Value2 = "</>" Then
'whatever you want to do
End If
End Sub
So at a second glance it looks like this. If you'd like to make it structured you'd need to use a countifs function first.
Sub Work()
Dim rng As Range, rngFound(1) As Range
Set rng = Range("B1:B200")
On Error GoTo Err 'it is quite possible it will run into an error if there are no matches and I'm too lazy for structured solution
Set rngFound(0) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext) 'finds the first
Set rngFound(1) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext, After:=rngFound(0)) 'finds the first after the first (i.e. the second)
Set rngFound(0) = rngFound(0).Offset(1, 8) '8 is the difference between B and J, row shifts as per description, I advise you to make it a variable
Set rngFound(1) = rngFound(1).Offset(-1, 8)
If rngFound(1).Row > rngFound(0).Row Then 'if it's not higher, then it recurred and found the first range again
rngFound(1).Offset(1, 2).Formula = "=SUM(" & Range(rngFound(0), rngFound(1)).Address & ")" 'L column will have the sum as a formula
Else
MsgBox "There is a single match in " & rng.Address(False, False)
End If
If False Then
Err:
MsgBox "There are no matches in " & rng.Address(False, False)
End If
End Sub
Now for the grand finale:
Sub Work()
Dim rng As Range, rngFound() As Range, rngdiff(1) As Long, rngcount As Long
Set rng = Range("B1:B200")
rngcount = rng.Cells.Count
ReDim rngFound(rngcount)
rngdiff(0) = Range("J1").Column - rng.Column ' the range that needs to be summed is in column J
rngdiff(1) = Range("L1").Column - rng.Column ' the range containing the formula is in column L
On Error GoTo Err 'it is quite possible it will run into an error if there are no matches and I'm too lazy for structured solution
Set rngFound(0) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext) 'finds the first
'loop starts
For i = 1 To rngcount
Set rngFound(i) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext, After:=rngFound(i - 1)) 'finds the next
If rngFound(i).Row > rngFound(i - 1).Row Then 'if it's not higher, then it recurred and found the first range again
rngFound(i).Offset(0, rngdiff(1)).Formula = "=SUM(" & Range(rngFound(i - 1).Offset(1, rngdiff(0)), rngFound(i).Offset(-1, rngdiff(0))).Address & ")" 'L column will have the sum as a formula
Else
Exit Sub 'if it recurred the deed is done
End If
Next i
If False Then
Err:
MsgBox "There are no matches in " & rng.Address(False, False)
End If
End Sub
I am trying to figure out a way to run a Vlookup on a Cell in my "System File" by checking a table in a "New Data" File. HOWEVER, if there is an #N/A error, I want the cells' values to be unchanged. I've come up with the following, however, I keep getting a "Next without For" error. Is it possible to escape a nested For Next loop?
The tl;dr semantic version:
For i 1 to 10
For j 1 to 3
Something with .Cells(i,j)
Set range X = .Find(thing
If X = Nothing Then
Next j *** <THIS IS WHERE MY ERROR IS THROWN
Else
-Do Something with X-
End if
Next j
Next i
My more or less actual code is as follows:
Sub Thing()
Dim SysWS As Worksheet
Dim NewDataWS As Worksheet
Dim NDSKUs As Range ' This is set to the first column of the NewDataWS
Dim NDMonthsRow As Range ' This is set to the first row of the NewDataWS
Dim SKU2look4 As String, Month2look4 As String
Dim ifoundtheSKU As Range 'the result of finding SKU2look4 inside of NDSKUs range
Dim ifoundtheDate As Range 'the result of finding Month2look4 inside of NDMonthsRow range
Dim i As Integer, j As Integer
Dim workzone As Range 'The Cell being evaluated
For i = 2 To SysWS.UsedRange.Columns.Count
For j = 2 To SysWS.UsedRange.Rows.Count
Set workzone = SysWS.Cells(j, i)
SKU2look4 = SysWS.Cells(j, 1) 'SKUs are along the left column
Month2look4 = SysWS.Cells(1, i) 'Dates are along the top row
'1-Find the right Date Column for extraction
Set ifoundtheDate = NDMonthsRow.Find(What:=Month2look4, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If ifoundtheDate Is Nothing Then
Debug.Print (Month2look4 & " -Date NOT Found in New Date File")
******Next j******
Else
Debug.Print ("ifoundtheDate:" & ifoundtheDate.Address)
End If
'2-Find the row
Set ifoundtheSKU = NDSKUs.Find(What:=SKU2look4, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If ifoundtheSKU Is Nothing Then
Debug.Print (SKU2look4 & " Not Found in the New Data File")
*********Next j******
Else
Debug.Print ("ifoundtheSKU:" & ifoundtheSKU.Address)
End If
'Set the "workzone" cell's value to that of the found row offset by the found column
workzone = ifoundtheSKU.Offset(, (ifoundtheDate.Column - 1))
Next j
Next i
Of course the ***s are not actually in there. Any thoughts on how I can accomplish this?
Thanks in advance
For i = 1 to 10
For j = 1 to 3
Something with .Cells(i,j)
Set rngX = .Find(thing)
If Not rngX Is Nothing Then
Set rngY = .Find(thingelse)
If Not rngY Is Nothing Then
'something with rngX and rngY
End If
End if
Next j
Next i
Use
For i=1 to 10
For j=1 to 3
Something with .Cells(i,j)
Set range X = .Find(thing
If X = Nothing Then
Goto Nextj *** <THIS IS WHERE MY ERROR IS THROWN
Else
-Do Something with X-
End if
NextJ:
Next j
Next i
Exit For terminates the current for loop early (the inner one in your case).