I am trying to check whether the values in workbook1-sheet1-A are matched in workbook2-sheet2-E. If there is a match workbook1-sheet1-Y receives a 'x'.
This is the code I have so far and gives me Run time error 424 - Object required error on the if loop.
Sub Check()
'
Application.ScreenUpdating = False
endRow = Range("A" & Rows.Count).End(xlUp).Row
wkbSLA = ("F:\Workbook2")
For i = 2 To endRow
If Cells(i, 1).Value = wkbSLA.Sheets("Sheet2").Range("E2:E575").Value Then
Range("Y" & i) = "x"
End If
Next i
'
End Sub
To ensure your code is doing everything you expect it to it, make sure you qualify your objects with variables.
Also, you cannot use the .Value property on multi-cell range. That is probably where your error is hitting. A better way to approach this is with the .Find method.
If you write the code something like this, it should work for you ... though you may need to tweak it a bit to meet your needs.
Option Explicit
Sub Check()
Application.ScreenUpdating = False
Dim wkb1 as Workbook, wkb2 as workbook
Set wkb1 = Workbooks("workbook1")
Set wkb2 = Workbooks("F:\Workbook2")
' -> do you need Workbooks.Open("F:\Workbook2") here?
' Seems you may if the workbook you want to access is closed
Dim wks1 as Worksheet, wks2 as Worksheet
Set wks1 = wkb1.Sheets(1) 'may need to change this reference for your needs
Set wks2 = wkb2.Sheets("Sheet2")
With wks1
Dim endRow as Long
endRow = .Range("A" & Rows.Count).End(xlUp).Row
Dim i as Long
For i = 2 To endRow
Dim rng as Range
Set rng = wks2.Range("E2:E575").Find .Cells(i,1).Value lookat:=xlWhole
If Not rng Is Nothing Then .Range("Y" & i) = "x"
Next i
End With
End Sub
Related
All, I am working part of my code where I want to update filtered noncontiguous cells with index / match. Core of my code is working in proper manner in another case but here seems wrong and do not know what is the reason behind. Working turn endless and could cause that no last row find in section here: Set rngI = usedR.Resize(usedR.Rows.Count - 1).Offset(5).Columns("I:I").SpecialCells(xlCellTypeVisible). Checked with debug.print the result which shows me the end as wrong...$I$174:$I$1046999...proper has to be $I$174:$I$197...what could be the reason behind?
Another question using lastrow calculation..on this way this doesnt work, Dim lastrow As Long, lastrow = rngD(Rows.Count, 1).End(xlUp).row I have to correct like this to count...lastrow = rngD(rngD.Rows.Count, 1).End(xlUp).row. What's the reason behind that once working on first way, once only if I double type range. This code is in Personal folder if it counts anyway
Sub Macro2()
Dim wbD As Workbook: Set wbD = Workbooks("dashboard-advanced.xls")
Dim wsD As Worksheet: Set wsD = wbD.Sheets("Sheet1")
Dim rngD As Range: Set rngD = wsD.Range("A:C")
Dim wbCallLCL As Workbook: Set wbCallLCL = Workbooks("CALL_REPORT.xlsx")
Dim wsCallLCL As Worksheet: Set wsCallLCL = wbCallLCL.Sheets("LCL")
Dim rngCallLCL As Range: Set rngCallLCL = wsCallLCL.Range("A:V")
rngCallLCL.autofilter Field:=10, Criteria1:=Blanks
Dim lastrow As Long
lastrow = rngD(rngD.Rows.Count, 1).End(xlUp).row
Dim usedR As Range, rngI As Range, A As Range, C As Range
Set usedR = wsCallLCL.UsedRange
Set rngI = usedR.Resize(usedR.Rows.Count - 5).Offset(1).Columns("I:I").SpecialCells(xlCellTypeVisible)
For Each A In rngI.Areas
For Each C In A.Cells
res = Application.Match(C.Value, wsD.Range("A2:" & "A" & lastrow), 0)
If IsError(res) Then
C.Offset(, 1).Value = ""
Else
C.Offset(, 1).Value = Application.WorksheetFunction.Index(wsD.Range("B2:" & "B" & lastrow), res, 0)
End If
Next C
Next A
End Sub
Okay, so I recently got into VBA programming and I have been trying to write some code to do the following :
Cycle through a column containing True or False Statements (column "K" in my case)
If True then gather the corresponding name (column "C") and create a sheet named accordingly
And that's all
So here is the code I wrote :
Sub Generate_Attribute_Table()
Dim LastRow As Long
Dim i As Integer
Dim Nom As String
LastRow = Range("A1").End(xlDown).Row
For i = 2 To LastRow
If (Cells(i, "K").Value) Then
Nom = Worksheets(1).Cells(i, "C").Value
ActiveWorkbook.Sheets.Add(After:=Worksheets(Sheets.Count)).Name = Nom
Else
Cells(i, "K").Select
End If
Next i
End Sub
And it seems to work perfectly fine but it stops after generating the first sheet even if there are other True in the column.
The else case is there for debug purposes as I wanted to see what was happening and it confirms that whenever the if statement is verified, the loop stops.
I tried doing the same thing using a "Do Until" loop but it does the same.
What am I missing here ? I couldn't find any answers online so any help would be really nice.
Thanks in advance.
Per Sheets.Add method documentation.
Creates a new worksheet, chart, or macro sheet. The new worksheet becomes the active sheet.
You have implicit references to the ActiveSheet so each time you add a new sheet, your code is now referencing the new worksheet.
Add some explicit reference to the worksheet you intend to use, such as:
LastRow = Sheets("Sheet1").Range("A1").End(xlDown).Row
And
Sheets("Sheet1").Cells(i, "K").Value
Add Worksheets with Names From a List
The following will still raise an error if the worksheet name is invalid.
Option Explicit
Sub Generate_Attribute_Table()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets(1) ' wb.Worksheets("Sheet1")
' This (usually preferred) way will allow empty cells in the column.
Dim LastRow As Long: LastRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
Dim dsh As Object
Dim Nom As String
Dim i As Long
For i = 2 To LastRow
' If you use '(sws.Cells(i, "K").Value)', an error will occur
' if there is not a boolean in the cell.
If sws.Cells(i, "K").Value = True Then
Nom = sws.Cells(i, "C").Value
' Attempt to create a reference to the sheet named 'Nom'.
Set dsh = Nothing
On Error Resume Next
Set dsh = wb.Sheets(Nom)
On Error GoTo 0
' Test for existence.
If dsh Is Nothing Then ' A sheet named 'Nom' doesn't exist.
wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = Nom
'Else ' A sheet named 'Nom' already exists.
End If
End If
Next i
End Sub
Figured it out ! And now I feel really dumb, all I had to do was to be precise about my cell reference. By simply writing :
If (ActiveWorkbook.Sheets(1).Cells(i, "K").Value) Then
It solved everything.
Try this:
Sub Generate_Attribute_Table()
Dim LastRow As Long
Dim i As Integer
Dim Nom As String
Dim Sh As Worksheet
Set Sh = ActiveWorkbook.Worksheets("Sheet1")
LastRow = Range("A1").End(xlDown).row
For i = 2 To LastRow
If Sh.Cells(i, 11).Value = True Then
Nom = Sh.Cells(i, 3).Value
ActiveWorkbook.Sheets.Add(After:=Worksheets(Sheets.count)).Name = Nom
Else
'Cells(i, 11).Select 'Commented because I don't see why you'd need it
End If
Next i
End Sub
I have a Macro that makes a header and I wanted to create a variant of it that allows me to append my array called headers() to the next empty row in a sheet. I've tried playing around with the macro even replacing the Range.insert with PasteSpecial however the results are the same: Whenever I run the Macro in the VBA Editor it appends rows like I want, however when I run it via a Command button as a part of another sub it just overwrites the same row (row 2) even if I fill in row 2 with something.
Sub MEData()
' Find Next Empty Row & Append ME Data
Dim headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim lastRow As Long
Dim lr As Long
Set wb = ActiveWorkbook
Set ws = ThisWorkbook.Sheets("ME Data")
If DesignChangeECN = "" Then
DesignChangeECN = "Not Design Change"
End If
headers() = Array(VBA.Environ("UserName"), Now(), MPP_ECN,
MPP_ECN_Description, DesignChangeECN, Dept, ShortChangeDescription,
ChangeType, "Additional Notes", _
"Open", "Submitted")
lastRow = Cells(ws.Rows.Count, 2).End(xlUp).row
Rows(lastRow).PasteSpecial
With ws
For i = LBound(headers()) To UBound(headers())
.Cells(lastRow, 1 + i).Value = headers(i)
Next i
End With
End Sub
I'm not super proficient in VBA so I'm not sure if I'm misusing or utilizing something incorrectly or if there is something super simple that I'm missing.
I found the answer after quite a few hours of reading and research best methods of handling arrays and rows. I settled on using a range instead of insert as that would make more sense, especially when I figured out that I could have a range set to my array It became simpler.
I did still immediately suffer from not incrementing rows however I fix that by having using ws.Activate I figured out that since the sheet that ran the Macro via a command button was acting as the "Active Sheet" called .Activate fixed my issue.
Sub MEData()
' Find Next Empty Row & Append ME Data
Dim headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim lastRow As Long
Set wb = ActiveWorkbook
Set ws = ThisWorkbook.Sheets("ME Data")
If DesignChangeECN = "" Then
DesignChangeECN = "Not Design Change"
End If
headers() = Array(VBA.Environ("UserName"), Now(), MPP_ECN, MPP_ECN_Description, _
DesignChangeECN, Dept, ShortChangeDescription, ChangeType, "Additional Notes", _
"Open", "Submitted")
ws.Activate
lastRow = Cells(ws.Rows.Count, 1).End(xlUp).row + 1
ws.Range("A" & lastRow & ":K" & lastRow) = headers()
End Sub
Function StripChar(Txt As String) As String
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\D"
StripChar = .Replace(Txt, "")
End With
End Function
So i am trying to apply this function on bottom range via loop through cells
Sub Alphabetremove()
Dim ws As Worksheet
Dim Lastrow As Integer
Set ws = ActiveSheet
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("F2:F" & Lastrow).Select
With Selection
.Value = StripChar(.Value)
End With
End Sub
The issue is that you cannot run the function .Value = StripChar(.Value) on a range at once (as you tried) but only on a single cell. Therfore you need to loop from row 2 to LastRow and apply the function to each single cell.
Also note that row counting variables need to be of type Long because Excel has more rows than Integer can handle. Actually I recommend always to use Long instead of Integer as there is no benefit in using Integer in VBA.
Also if you set your worksheet to a variable ws you need to use this variable for all .Cells and .Range objects otherwise this is useless.
Option Explicit
Public Sub Alphabetremove()
Dim ws As Worksheet
Set ws = ActiveSheet 'better define a workseet by name unless you use the code for multiple worksheets:
'Set ws = ThisWorkbook.Worksheets("MySheet")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim Cell As Range
For Each Cell In ws.Range("F2:F" & LastRow)
Cell.Value = StripChar(Cell.Value)
Next Cell
End Sub
Finally I highly recommend you to read How to avoid using Select in Excel VBA and apply this to all of your code.
Can anyone explain me if I can recursively loop through a sorted list inside a For loop?
I am looping through a column, and once I found an exact match (lets say EALOLES string), then I want to keep on looping until there's no more matches.
Data example
For i = 2 to UsedRange.Rows.Count
If (Cells(i, 12).Value = "EALOLES") Then
' Start an inner loop until EALOLES ends, increment i++
' Perform actions appropriate to EALOLES case
Exit For
End If
next i
This is all fine with an inner loop, but I was just wondering if this could be achieved also with a recursive function and how that would look like? From the example I learned about recursion, I would imagine to loop from end of workbook to the beginning.
Note, I am not stating it would be a better solution, neither an inner loop, but I am just very curious.
Your question is basically is this a candidate for recursion, and the answer is no. Iteration with your inner loop is the better solution in this case.
Read the article: Recursion and Iteration to learn when to use each.
Assuming your data are sorted, you could take advantage of that
Dim nOccurrences As Long
Dim cell As Range
With Intersect(ActiveSheet.UsedRange, Columns(12))
nOccurrences = WorksheetFunction.CountIf(.Cells, "EALOLES")
If nOccurrences > 0 Then
For Each cell in .Resize(nOccurrences).Offset(.Find(What:= "EALOLES", LookIn:=xlValues, LookAt:=xlWhole, After:=.Cells(.Rows.Count)).Row-1)
‘Do your things
Next
End If
End With
This is not an efficient method of returning the start and stop positions of a string in a sorted list but as an intellectual excercise this should do.
dim i as long, j as long
For i = 2 to UsedRange.Rows.Count
If (Cells(i, 12).Value = "EALOLES") Then
for j=i to UsedRange.Rows.Count
If (Cells(j+1, 12).Value <> "EALOLES") Then
exit for
end if
next j
Exit For
End If
next i
debug.print "start: " & i
debug.print "end: " & j
I was musing with a slightly different take on the same theme
Define a range to loop over. See if the value exists in the range. If it does, start at the first match and keep looping the loop range until the cell value differs from the specified target string.
Option Explicit
Sub StopAtEnd()
Dim wb As Workbook
Dim ws As Worksheet
Dim endRow As Long
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet5") 'change as needed
endRow = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row
Dim loopRange As Range
Set loopRange = ws.Range("L1:L" & endRow) 'Change start row as required
Dim currentCell As Range
Dim targetString As String
Dim startRow As Long
targetString = "EALOLES"
On Error GoTo Errhand
startRow = Application.Match(targetString, loopRange, 0)
Do Until ws.Range("L" & startRow) <> targetString
Debug.Print ws.Range("L" & startRow).Address
startRow = startRow + 1
Loop
Exit Sub
Errhand:
MsgBox "Target string not found"
End Sub
Shout out to #DisplayName who pointed out this could be written instead as:
Option Explicit
Sub StopAtEnd()
Dim wb As Workbook
Dim ws As Worksheet
Dim endRow As Long
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1") 'change as needed
endRow = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row
Dim loopRange As Range
Set loopRange = ws.Range("L1:L" & endRow) 'Change start row as required
Dim currentCell As Range
Dim targetString As String
Dim startRow As Variant
targetString = "EALOLES"
startRow = Application.Match(targetString, loopRange, 0)
If IsError(startRow) Then
MsgBox "Target string not found"
Else
Do Until ws.Range("L" & startRow) <> targetString
Debug.Print ws.Range("L" & startRow).Address
startRow = startRow + 1
Loop
End If
End Sub