I have 3 columns, with headers A B & C as shown at the picture, and I want to check if the value in column A is equal to 10% of column B, if yes, I want to set it to be the value for column C, if not, I want to get 10% of values in column B. I am in sheet1 and I want to set a VBA button in sheet2 to run the codes.
Here is the code:
Sub Macro1()
Dim ws As Worksheet, lastrow As Long
Set ws = Worksheets("sheet1")
ws.Activate
ActiveCell.Formula = "=IF(A2=B2*0.1, A2, B2*0.1)"
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range("C2").AutoFill Destination:=Range("C2:C" & lastrow), Type:=xlFillDefault
End Sub
My issues is if I point my mouse at C2 in sheet1 and I just run the vba codes, it will work. If I am at sheet2 and pressing the button, it won't work, it just doesn't show any data. Is there a way to set values to column C based on my criteria?
To make the code working on sheet1 independently of active sheet is, you need to apply .Range method exactly to Worksheets("sheet1") object. Try the below code:
Sub Macro1()
Dim lastrow As Long
With Worksheets("sheet1")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row
If lastrow = 1 Then
MsgBox "No data"
Exit Sub
End If
.Range("C2:C" & lastrow).Formula = "=IF(A2=B2*0.1, A2, B2*0.1)"
End With
End Sub
Why not to be more straightforward: always set the value to column C equal to 10% of column B? The result will be the same.
Sub Macro1()
Dim lastrow As Long
With Worksheets("sheet1")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row
If lastrow = 1 Then
MsgBox "No data"
Exit Sub
End If
.Range("C2:C" & lastrow).Formula = "=B2*0.1"
End With
End Sub
Related
I have a workbook with 3 sheets: first one is the raw data sheet, then 2 target sheets. I would need a macro that would look at cell C in raw data sheet and based on the 2 values (YES or NO), will copy and paste the range A:Y in sheets 2, respectively 3.
Example: if on C2 in raw data sheet i have YES, copy A2:Y2 and paste into sheet 2, same range A2:Y2. If instead i have the value NO, copy A2:Y2 and paste into sheet 3.
Then go to next row and copy-paste A3:Y3 to sheet 2 if YES or A3:Y3 to sheet 3 if NO.
I wrote something that only works for the 2nd row, but i don't know how to make it loop... so basically when it passes to the next rows, it still copies the values from A2:Y2 to the target sheet, instead of copying A3:Y3, A4:Y4 etc..
Pasting my poor code below:
Sub IdentifyInfraction()
Dim rngA As Range
Dim cell As Range
Set rngA = Range("C2", Range("C65536").End(xlUp))
For Each cell In rngA
Worksheets("raw_data").Select
If cell.Value = "YES" Then
Range("A2:Y2").Copy
Worksheets("Value_YES").Select
Range("A2").PasteSpecial Paste:=xlPasteValues
ElseIf cell.Value = "NO" Then
Range("A2:Y2").Copy
Worksheets("Value_NO").Select
Range("A2").PasteSpecial Paste:=xlPasteValues
End If
Next cell
End Sub
Please help!!! :-s
Easiest solution would just be to replace the number 2 in each of your ranges to a variable which you then increment at the end your statement, before you go to the next cell.
For example:
Dim i = 2
Set rngA = Range("C2", Range("C65536").End(xlUp))
For Each cell In rngA
Worksheets("raw_data").Select
If cell.Value = "YES" Then
Range("A" & i & ":Y" & i).Copy
Worksheets("Value_YES").Select
Range("A" & i).PasteSpecial Paste:=xlPasteValues
ElseIf cell.Value = "NO" Then
Range("A" & i & ":Y" & i).Copy
Worksheets("Value_NO").Select
Range("A" & i).PasteSpecial Paste:=xlPasteValues
End If
i = i + 1
Next cell
So, originally we set i = 2, this is to go in line with your starting row of 2 mentioned in your question. Then, Range("A" & i & ":Y" & i).Copy is the same as saying Range("A2:Y2").Copy or Range("A3:Y3").Copy, etc.
This will go through any copy each row, a new row each time, and paste it to the respective row in the various sheets.
I hope this works for what you are trying to do, if not let me know.
There are a few things I'd also recommend looking into. There's a much better way to copy and paste, without going back and forward through the sheets.
ThisWorkbook.Sheets("raw_data").Rows(i).Copy Destination:=Worksheets("Value_YES").Range("A" & i)
Something like this would take the whole row from raw_data and transfer it to Value_YES. You'd have to mess around with it and change the range from Rows(i), but that's just an example.
I'd also recommend that you look into How to avoid using Select in Excel VBA to better understand why it's frowned upon to use Select and Activate in Excel VBA.
My version:
Sub GetR_Done()
Dim rng As Range, c As Range, LstRw As Long
Dim ws As Worksheet, Nr As Long, Yr As Long
Dim Ys As Worksheet, Ns As Worksheet
Set ws = Sheets("raw_data")
Set Ys = Sheets("Value_YES")
Set Ns = Sheets("Value_NO")
With ws
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C2:C" & LstRw)
For Each c In rng.Cells
If c = "YES" Then
With Ys
Yr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy Ys.Range("A" & Yr)
End If
If c = "NO" Then
With Ns
Nr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy Ns.Range("A" & Nr)
End If
Next c
End With
End Sub
If you really require to paste values, then use this one
Sub GetR_Done()
Dim rng As Range, c As Range, LstRw As Long
Dim ws As Worksheet, Nr As Long, Yr As Long
Dim Ys As Worksheet, Ns As Worksheet
Set ws = Sheets("raw_data")
Set Ys = Sheets("Value_YES")
Set Ns = Sheets("Value_NO")
Application.ScreenUpdating = False
With ws
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C2:C" & LstRw)
For Each c In rng.Cells
If c = "YES" Then
With Ys
Yr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy
Ys.Range("A" & Yr).PasteSpecial xlPasteValues
End If
If c = "NO" Then
With Ns
Nr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy
Ns.Range("A" & Nr).PasteSpecial xlPasteValues
End If
Next c
End With
Application.CutCopyMode = False
End Sub
you could try this:
Sub IdentifyInfraction()
Dim cell As Range
With Worksheets("raw_data") 'reference "raw data" sheet
For Each cell In .Range("C2", .cells(.Rows.Count, "C").End(xlUp)) ' loop through referenced sheet column C cells from row 2 down to last not empty one
Worksheets("Value_" & cell.Value).Range(cell.Address).Resize(, 25).Value = cell.Resize(, 25).Value 'have proper target sheet A:Y current cell row values as "raw data" sheet ones
Next
End With
End Sub
The problem I am facing is this: I can't construct a code that would go to the bottom of the data in column A (data in A grows constantly so the code needs to always look for the lRow) and that would fill in all blank cells (which are not fixed and are changing whenever I update the data) e.g. in lRow between A:G with value "x".
Thank you
Try this:
Sub FillCells()
Dim lastRow As Long, rng as Range, cl as Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set rng = Range("A" & lastRow & ":G" & lastRow)
For each cl in rng
If cl = "" Then
cl = "x"
End if
Next cl
End Sub
The code finds the next blank cell in column A and fills that row from columns A to G with the value "x".
use lastRow = Range("A" & Rows.Count).End(xlUp).Row.offset(1,0)
lastRow.value="c
that will gi
I have a macro that looks for records in Column B and if there is a value in a cell within that column then the macro will add a value to Column A in the same row. My problem occurs when Column B has NO values in it whatsoever. The macro just continues running endlessly in those instances. What I am looking for is a way to say:
If Column B contains NO value then skip to the next macro.
I know this involves an IF statement of some kind I just can not figure out how to add that logic into my existing code.
My code:
Sub Update_Column_Based_On_Column_Value_1()
On Error Resume Next
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=If(LEN(RC2),""NEW VALUE GOES HERE"", TEXT(,))"
.Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value
End With
End Sub
My search for the answer yielded this string of code from another StackOverflow question:
If WorksheetFunction.CountBlank(emailRng) = emailRng.Cells.Count Then Exit Sub 'No data
When I added that to my code it simply ended the sub if there were ANY blank cells in a column.
Thanks in advance for the assistance! I do apologize if my question is overly noobish.
Try this:
Sub Update_Column_Based_On_Column_Value_1()
On Error Resume Next
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
' This will count all non-blanks in Column B, I put equal to 1
' because I am assuming B1 is a header with a title so it will at minimum be 1
If WorksheetFunction.CountA(ws.Range("B:B")) = 1 Then
' if count is equal to 1 then this part will run
' so enter name of the sub() or write new code in here
Else
' if not less than or equal, meaning greater than 1
' then the following code below will run
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=If(LEN(RC2),""NEW VALUE GOES HERE"", TEXT(,))"
.Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value
End With
End If
This code will do what you want
Sub test()
Dim i As Long
Dim lRow As Long
lRow = Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To lRow
If Cells(i, "B").Value <> vbNullString Then
Cells(i, "A").Value = Cells(i, "B").Value
End If
Next i
End Sub
I have two Sheets, sheet1 and sheet 2.
I am looking into column T of sheet1 and pasting the complete row if T contains 1 in sheet 2.
The code, works good, but it paste the result in sheet2 in the same row in sheet1.
This results in blanks, between the rows. Can anyone suggest, what i should Change with my code, so that i get them in sequence without any blank rows.
Also, how can I copy the Header in row 1 from sheet 1 to sheet2?
Sub Test()
For Each Cell In Sheets(1).Range("T:T")
If Cell.Value = "1" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets(1).Select
End If
Next
End Sub
There's no need to use Select and Selection to copy paste, it will only slows down your code's run-time.
Option Explicit
Sub Test()
Dim Cell As Range
Dim NextRow as Long
Application.ScreenUpdating = False
For Each Cell In Sheets(1).Range("T1:T" & Sheets(1).Cells(Sheets(1).Rows.Count, "T").End(xlUp).Row)
If Cell.Value = "1" Then
NextRow = Sheets(2).Cells(Sheets(2).Rows.Count, "T").End(xlUp).Row
Rows(Cell.Row).Copy Destination:=Sheets(2).Range("A" & NextRow + 1)
End If
Next
Application.ScreenUpdating = True
End Sub
Not For Points
Apologies, but I couldn't stop myself from posting an answer. It pains me when I see someone wanting to use an inferior way of doing something :(
I am not in favor of looping. It is very slow as compared to Autofilter.
If you STILL want to use looping then you can make it faster by not copying the rows in the loop but in the end in ONE GO...
Also if you do not like living dangerously then always fully qualify your object else you may end up copying the wrong row.
Option Explicit
Sub Sample()
Dim wsI As Worksheet, wsO As Worksheet
Dim lRow As Long, i As Long, r As Long
Dim copyRng As Range
Set wsI = Sheet1: Set wsO = Sheet2
wsO.Cells.Clear
'~~> first available row in sheet2
r = 2
With wsI
lRow = .Range("T" & .Rows.Count).End(xlUp).Row
'~~> Copy Headers
.Rows(1).Copy wsO.Rows(1)
For i = 1 To lRow
If .Range("T" & i).Value = 1 Then
If copyRng Is Nothing Then
Set copyRng = .Rows(i)
Else
Set copyRng = Union(copyRng, .Rows(i))
End If
End If
Next i
End With
If Not copyRng Is Nothing Then copyRng.Copy wsO.Rows(r)
End Sub
Screenshot
I would like a to make a macro to run vlookup from the last row filled.
The following code is to get the last row to be filled (column J) and the last row filled (column A), the following formula is to get the last rows of this 2 columns;
Sub lookup()
'Find the last Row with data in a Column
'In this example we are finding the last row of column A (Filled) and J (to be filled)
Dim lastRowA As Long
Dim lastRowJ As Long
With ActiveSheet
lastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
lastRowJ = .Cells(.Rows.Count, "J").End(xlUp).Row
End With
MsgBox lastRowA & " " & lastRowJ
End Sub
The vlookup looks for the value in column C and look in the range in another excel file C:\LINKED[Roster_Iloilo.xlsx]ACTIVE'!$C:$E. See picture of the File
Will need help with the vlookup please.
Is this what you are trying? (Untested)
You can write your formula
"=vlookup(C40846,'C:\LINKED[Roster_Iloilo.xlsx]ACTIVE'!$C:$E,3,0)"
as
"=vlookup(C" & "40846" & ",'C:\LINKED[Roster_Iloilo.xlsx]ACTIVE'!$C:$E,3,0)"
So all you have to do is replace the last row :)
Sub Sample()
Dim ws As Worksheet
Dim lastRowA As Long
Dim sFormulaPre As String
Dim sFormulaSuff As String
Set ws = ThisWorkbook.Sheets("Sheet1")
'=vlookup(C40846,'C:\LINKED[Roster_Iloilo.xlsx]ACTIVE'!$C:$E,3,0)
sFormulaPre = "=vlookup(C"
sFormulaSuff = ",'C:\LINKED[Roster_Iloilo.xlsx]ACTIVE'!$C:$E,3,0)"
With ws
lastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
MsgBox sFormulaPre & lastRowA & sFormulaSuff
'~~> Usage
'.Cells(1, 1).Formula = sFormulaPre & lastRowA & sFormulaSuff
End With
End Sub