I'm trying to write a script in a workbook that will check a separate worksheet ("Worksheet 2") in row 10 for a value ("Yes") - See
Worksheet 2 Column B
If it returns with a yes I want to copy the cell in Row 4 in the same column (in this case B4) and paste it to "Worksheet 1" in column B starting on Row 2 - See Worksheet 1 Column B
Then I want it to check the next 100 rows for the same info and paste all of the Row 4 Cells that have yes from Row 10 into "Worksheet 1 - Row B". Here is what I currently have:
Sub CommandButton1_Click()
Dim lr As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row
For Each Sheets("Option 2").Cell In Range("B10:CZ10")
If Cell.Value = Range("Yes").Value Then
Worksheets("Option 2").Cell.Range(B4).Copy Range("B")
Exit Sub
End If
Next Cell
Worksheets("Option 2").Range("B5:CW10").Copy Range("B")
Range("B" & lr + 1).PasteSpecial Paste:=xlPasteValues
End Sub
Sorry if this is written horribly. I'm new to VBA and don't have a lot of guidance. Any help will be greatly appreciated!
Perhaps this is what you are attempting.
Sub CommandButton1_Click()
Dim lr As Long, rng as range
lr = Cells(Rows.Count, "B").End(xlUp).Row
For Each rng In Sheets("Option 2").Range("B10:CZ10")
If lcase(rng.Value) = "yes" Then
lr = lr+1
cells(lr, "B") = rng.offset(-6, 0).value
End If
Next rng
End Sub
Related
I am trying to loop through all sheets and check them one by one and do the following: If in the checked cell the value of E18 = N/A then on the first sheet (named Summary) I'd change the value of G23 to N/A as well (and then do that for each cell, and on Summary change G23 then G24 then G25 and so forth) I wrote the following loop, it runs but it doesn't do anything whatsoever
Sub MyTestSub()
Dim ws As Worksheet
LastRow = Cells(Rows.Count, "G").End(xlUp).Row
For X = 22 To LastRow
For Each ws In Worksheets
If ws.Range("E18").Value="N/A" then ThisWorkbook.Sheets("Summary").Range("G"&x).Value="N/A"
Next ws
Next x
End Sub
Any help would be appreciated!
It needs to be a 2-Step procedure:
Check if IsError in the cell.
Check if the type of error is #N/A, with If .Range("E18").Value = CVErr(xlErrNA) Then.
Otherwise, if you have a regular String, like "Pass" you will get an error.
Code
Dim lRow As Long
LastRow = Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "G").End(xlUp).Row
lRow = 23 ' start from row 23
For Each ws In Worksheets
With ws
If .Name <> "Summary" Then
If IsError(.Range("E18").Value) Then
If .Range("E18").Value = CVErr(xlErrNA) Then
Sheets("Summary").Range("G" & lRow).Value = CVErr(xlErrNA)
End If
End If
End If
End With
lRow = lRow + 1
Next ws
Try to reverse the nested loops. Something like this should be working:
Sub MyTestSub()
Dim ws As Worksheet
For Each ws In Worksheets
LastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
If IsError(ws.Range("E18")) then
For X = 22 To LastRow
Sheets("Summary").Range("G" & LastRow) = ws.Range("E18")
next x
end if
Next ws
End Sub
Furthermore, I assume that the LastRow is different per worksheet, thus you have to reset it quite often - every time there is a new worksheet.
Last but not least - make sure that you refer the worksheet, when you are refering to Cells, like this:
LastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
If you do not do it you will be taking into account the ActiveSheet.
Here is more about the errors in Excel and returning them - http://www.cpearson.com/excel/ReturningErrors.aspx
The solution will work with any error, not only with #N/A
I am very new to VBA. Just started reading it up 2 days ago. I am wondering how could I write a VB codes assigned to a button to read through the whole column and search for similar numbers.
After that identifying similar numbers, it would need to move on to another column to check if the character in the column are same too.
If both of the logic = true . How can i change the cell of the value of another column?
Sample data
For the current example. The code should know that the first column had matching numbers. After that it will check for the name which is "a" in the example. After that it will automatically change the point to 1 and 0. If there are 3 same ones it will be 1,0,0 for the point
You may try recording whatever you want to do with record macros first, then filter out the codes that are not necessary. If you do not know how to record it using macros, click on the link below. You can learn from the recorded macros and slowly improvise your codes in the future from the experience you may gain.
Here's [a link] (http://www.dummies.com/software/microsoft-office/excel/how-to-record-a-macro-in-excel-2016/)
As per image attached in image I am assuming numbers are in Column A, column to check characters is Column J and result needs to be displayed in Column O then try following code.
Sub Demo()
Dim dict1 As Object
Dim ws As Worksheet
Dim cel As Range, fCell As Range
Dim lastRow As Long, temp As Long
Dim c1
Set dict1 = CreateObject("Scripting.Dictionary")
Set ws = ThisWorkbook.Sheets("Sheet2") 'change Sheet2 to your data sheet
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'last row with data in Column A
c1 = .Range("A2:A" & lastRow)
For i = UBound(c1, 1) To 1 Step -1 'enter unique values with corresponding values in dict1
dict1(c1(i, 1)) = .Range("J" & i + 1) '+1 for Row 2
Next i
Set fCell = .Range("A2")
For Each cel In .Range("A2:A" & lastRow) 'loop through each cell in Column A
temp = WorksheetFunction.CountIf(.Range(fCell, cel.Address), cel) 'get count
If temp > 1 Then
If cel.Offset(0, 9) = dict1(cel.Value) Then
cel.Offset(0, 14).Value = 0
Else
cel.Offset(0, 14).Value = 1
End If
Else
cel.Offset(0, 14).Value = 1
End If
Next cel
End With
End Sub
EDIT
Sub Demo()
Dim ws As Worksheet
Dim lastRow As Long
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Sheet2") 'change Sheet3 to your data range
With ws
lastRow = .Cells(.Rows.count, "A").End(xlUp).Row 'last row with data in Column A
.Range("O2").Formula = "=IF(MOD(SUMPRODUCT(($A$2:$A2=A2)*($J$2:$J2=J2)),3)=1,1,0)" 'enter formula in Cell O2
.Range("O2").AutoFill Destination:=.Range("O2:O" & lastRow) 'drag formula down
.Range("O2:O" & lastRow).Value = .Range("O2:O" & lastRow).Value 'keep only values
End With
Application.ScreenUpdating = True
End Sub
I have a list of data in excel consisting of "Yes" and "No".
I need an IF statement that will only act on cells with the "Yes" value, and skip any cells with the "No" value.
For context, the 'value if true' clause of my IF statement is an indexmatchmatch which needs to return a value in the sheet based on the "Yes" or "No".
I understand this could have a simple solution using VBA, so if anyone has an excel based solution or VBA based solution they would be equally helpful.
I can add columns and rows to the dataset I am working with if needs be.
Try this:
Sub YesNo()
Dim lRow As Long
Dim sht As Worksheet
Set sht = Worksheets("Tabelle1")
lRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lRow
If sht.Cells(i, 1).Value = "True" Then 'Modify Column
'Your Code
End If
Next i
End Sub
Use VBA to achieve it
Assume in sheet , you have
A Yes
B Yes
C No
A Yes
B No
C Yes
A No
B No
After running the macro, Sheet 2 will have only those rows which have yes in Sheet1. Please modify the code based on your requirement
Sub g()
Dim lastRow As Long
Dim sheet As Worksheet
Set sht = Worksheets("Sheet1")
Set sht1 = Worksheets("Sheet2")
lRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
Dim j As Long
j = 1
For i = 1 To lRow
If sht.Cells(i, 2).Value = "Yes" Then
sht1.Cells(j, 1).Value = sht.Cells(i, 1).Value
j = j + 1
End If
Next i
End Sub
I have an excel workbook with 3 sheets, the first two contain lots of data and the third is blank.
I want to create a macro that copies all the highlighted/yellow cells from sheet 1 & 2 and pastes them in sheet 3.
I have some code in a macro which at the minute is only to copy sheet 1 to sheet 3 but it copies everything even though i have used If .Interior.ColorIndex
Sub Yellow()
Dim LR As Long, i As Long, j As Long
j = 1
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With Worksheets("Sheet1").Range("A1:CF200" & i)
If .Interior.ColorIndex Like 27 Or 12 Or 36 Or 40 Or 44 Then
.Copy Destination:=Worksheets("Sheet3").Range("J" & j)
j = j + 1
End If
End With
Next i
End Sub
UPDATE: code below modified to skip yellow-highlighted cells that are blank...
I might break this one up into two sections, a script that does the looping through sheets and a function that checks if a cell (Range) is yellow. The code below has lots of comments which walk through the steps:
Option Explicit
Sub PutYellowsOnSheet3()
Dim Sh As Worksheet, Output As Worksheet
Dim LastRow As Long, LastCol As Long
Dim Target As Range, Cell As Range, Dest As Range
Dim DestCounter As Long
'initialize destination counter and set references
DestCounter = 1
Set Output = ThisWorkbook.Worksheets("Sheet3")
'loop through sheets that are not named "Sheet3"
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> "Sheet3" Then
With Sh
LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set Target = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With
For Each Cell In Target '<~ loop through each cell in the target space
If AmIYellow(Cell) And Cell.Value <> "" Then '<~ blank check too
Set Dest = Output.Cells(DestCounter, 1)
Cell.Copy Dest
DestCounter = DestCounter + 1 '<~ keep incrementing on sheet 3
End If
Next Cell
End If
Next Sh
End Sub
'call this function when you'd like to check if a range is yellow
Public Function AmIYellow(Cell As Range) As Boolean
If Cell Is Nothing Then
AmIYellow = False
End If
Select Case Cell.Interior.ColorIndex '<~ this is the yellow check
Case 27, 12, 36, 40, 44
AmIYellow = True
Case Else
AmIYellow = False
End Select
End Function
Your condition
.Interior.ColorIndex Like 27 Or 12 Or 36 Or 40 Or 44
always evaluates to True (any number except 0 is True) so in fact your condition is:
'condition' Or True Or True ...
should be:
`.Interior.ColorIndex Like 27 _
Or .Interior.ColorIndex Like 12 _
Or .Interior.ColorIndex Like 36 _
Or .Interior.ColorIndex Like 40 _
Or .Interior.ColorIndex Like 44`
or better rewritten as:
Select Case .Interior.ColorIndex
case 27,12,36,40,44
'action
Case Else
'do nothing
End Select
There are several mistakes to be found in your script. I think you want to loop all the cells in the given range and copy over only the cells that have the specified colors. That could be done like this:
Sub jzz()
Dim LR As Long, i As Long, j As Long
Dim c As Range
j = 1
LR = Range("A" & Rows.Count).End(xlUp).Row
For Each c In Worksheets("Blad1").Range("A1:G" & LR)
If c.Interior.ColorIndex = 6 Then
c.Copy Destination:=Worksheets("Blad2").Range("A" & j)
j = j + 1
End If
Next c
End Sub
You will need to modify the code somewhat, for example "Blad1" will not exist in your workbook, and I took only ColorIndex = 6
I have one file with two worksheets, both are full of names and addresses. I need a macro that will highlight rows in the first sheet if the cell A of that row does not match any rows from column A of the second sheet.
So if the first cell in a row has no matching data in any of the data in column A of sheet2 then that row is highlighted red.
Also I might want to expand this in the future so could I also specify that Sheet1 can be the active sheet, but sheet2 is called by the sheet name?
Try below code :
Sub Sample()
Dim lastRow As Integer
Dim rng As Range
lastRow = Sheets("Sheet1").Range("A65000").End(xlUp).Row
For i = 1 To lastRow
Set rng = Sheets("sheet2").Range("A:A").Find(Sheets("Sheet1").Cells(i, 1))
If rng Is Nothing Then
Sheets("Sheet1").Cells(i, 1).EntireRow.Interior.Color = vbRed
End If
Next
End Sub
Here's an ugly brute-force approach:
Dim r As Range
Dim s As Range
For Each r In ActiveSheet.UsedRange.Rows
For Each s In Sheets("Sheet2").UsedRange.Rows
If r.Cells(1, 1).Value = s.Cells(1, 1).Value Then
r.Interior.ColorIndex = 3
End If
Next s
Next r
Here's a slicker way:
Dim r As Range
Dim s As Range
Set s = Sheets("Sheet2").Columns(1)
For Each r In ActiveSheet.UsedRange.Rows
If Not (s.Find(r.Cells(1, 1).Value) Is Nothing) Then
r.Interior.ColorIndex = 3
End If
Next r
how about this:
Sub CondFormatting()
Range("D1:D" & Range("A1").End(xlDown).Row).Formula = "=IF(ISERROR(VLOOKUP(A:A,Sheet2!A:A,1,FALSE)),""NOT FOUND"",VLOOKUP(A:A,Sheet2!A:A,1,FALSE))"
With Columns("D:D")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""NOT FOUND"""
.FormatConditions(1).Interior.ColorIndex = 3
End With
Range("I16").Select
End Sub
here is an approach using a Worksheet formula:
=IF(ISERROR(VLOOKUP(A:A,Sheet2!A:A,1,FALSE)),"NOT FOUND",VLOOKUP(A:A,Sheet2!A:A,1,FALSE))
then you would use Conditional formatting to turn the cells red if column A doesn't find a match!
HTH
Philip