Copy cell C value to other sheet if Cell A = Cell B - vb.net

I am new to vb macro, what I want to do is if cell A (list) = cell b then copy the value of cell C to another sheet, once copied, if the list changes to another name, the value of cell C should be empty, but the previously copied value from cell C should be retained.
I have this code but it seems it doesn't run.
Sub SearchMacro()
Dim LR As Long, i As Long
With Sheets("M-List")
LR = .Range("T" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With .Range("T" & i)
If .Value = "JAN!D158=N2" Then
Sheets("JAN!").Range("D158:H158").Copy Destination:=Sheets("M-List!").Range("T2")
End If
End With
Next i
End With
End Sub

Your question seems confusing from the beginning. If you want to compare two cells you do
Sheets("Sheet1").Range("A1").Value = Sheets("Sheet1").Range("B50").Value
Your code seems a little bit odd with what you said you want to do, but here are some recommendations so you can play with it
Try .Formula instead of .Value = "JAN!D158=N2", If .Formula = "JAN!D158=N2" Then
Try Sheets("JAN") instead of "JAN!"
You may want to use .Value instead of .Copy
Sheets("M-List").Range("T2").Value = Sheets("JAN!").Range("D158:H158").Value
You may want to use variables for the row numbers D158 or T2 like .Range("T" & var_row)

Related

Copy and paste things into the next empty cell in column

I've been trying to figure this out for ages. I've found an answer on StackOverflow but I get object error when trying to use it. I want to copy a set of data from a sheet based on a condition and then paste it in the next empty cell in a column on another sheet. This is my code:
Public list As Worksheet
Public bsawt As Worksheet
Sub Check2()
Set bsawt = Sheets("BSAW_TABLE")
Set list = Sheets("LIST")
lastrow = list.Cells(Rows.Count, "K").End(xlUp).Row
For x = 13 To lastrow
If list.Range("K" & x).Value = "BSAW" Then list.Range("L" & x).Copy Destination:=bsawt.Range("A1").End(xlDown).Offset(1, 0)
Next x
End Sub
If you have nothing in column A, or an entry in A1 only, then copying to this destination
Destination:=bsawt.Range("A1").End(xlDown).Offset(1, 0)
is equivalent to going to the last cell in column A in the worksheet and then attempting to go down one further row, which is clearly an impossibility. See also #PEH's comment.
Instead, work up from the bottom.
Destination:=bsawt.Range("A" & rows.count).End(xlup).Offset(1, 0)

First blank ("") cell in column with IF formula

I have a macro that exactly copies one sheet's data into another.
Sub QuickViewRegMgmt()
("Reg Management").Select
Cells.Select
Selection.Copy
Sheets("Quick View Reg Mgmt").Select
Cells.Select
ActiveSheet.Paste
End Sub
I would like for this macro to also go to the last non-blank cell in Column C (or first blank, I really don't care either way). I tried simple end/offset code, e.g.
Range("A1").End(xldown).Offset(1,0).Select
My problem, however, is that the direct copy macro also copies the underlying formulas, which for Column C is an IF formula. Therefore, no cell in the column is actually empty, but rather they all have an IF formula resulting in a true/false value (respectively, a "" or VLOOKUP).
=IF(VLOOKUP('Reg Management'!$Y260,'Reg Guidance'!$A:$V,3,FALSE)=0,"",VLOOKUP('Reg Management'!$Y260,'Reg Guidance'!$A:$V,3,FALSE))
That means the end/offset code goes to the last cell in the column with the formula (C1000) instead of going to the first cell that has a value of "" (which is currently C260).
What code can I add to this macro to select the first cell that contains an IF formula resulting in a value of "" ---- which has the appearance of being blank?
After trying to be fancy with SpecialCells(), or using Find() or something I couldn't get it ...so here's a rather "dirty" way to do it:
Sub test()
Dim lastRow As Long, lastFormulaRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Dim i As Long
For i = lastRow To 1 Step -1
If Cells(i, 1).Formula <> "" And Cells(i, 1).Value = "" Then
lastFormulaRow = i
Exit For
End If
Next i
End Sub
Edit2: Here's one using .SpecialCells(). Granted I think we can whittle this down more, I like it better:
Sub lastRow()
Dim tempLastRow As Long
tempLastRow = Range("C" & Rows.Count).End(xlUp).Row
Dim lastRow As Range
Set lastRow = Columns(3).SpecialCells(xlCellTypeFormulas).Find(What:="", LookIn:=xlValues, LookAt:=xlWhole, searchdirection:=xlPrevious, after:=Range("C" & tempLastRow))
Debug.Print lastRow.Row
End Sub
It returns 10 as the row.
Edit: Be sure to add the sheet references before Range() and Cells() to get the last row. Otherwise, it's going to look at your active sheet to get the info.

LOOP: Copy Cells Value (in a list) from one Sheet to Another

The purpose of this macro is copy one cell value (from a long list) to another cell located in a different sheet.
here's my code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G2:G1048576")
For Each cell In Rng
'test if cell is empty
If cell.Value <> "" Then
finaljnl.Range("L4").Value = rawben.Range("G5").Value
finaljnl.Range("K4").Value = rawben.Range("L5").Value
End If
Next
End Sub
With the help of the image, I will explain what I'm trying to achieve:
From Sheet1 ("BEN") there's a list sitting in columns G and L.
I will copy the cell G5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range K4.
Next is I will copy the cell L5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range L4.
Copy the next in line and do the same process just like No.2 and 3 but this time, it will adjust 1 row below.
Copy the whole list. That means up to the bottom. The list is dynamic, sometimes it will go for 5,000 rows.
For some reasons, copying the entire column is not an option to this macro due to requirement that cells from sheet1 MUST be pasted or placed in Sheet2 from left to right (or horizontally).
I hope you could spare some time to help me. My code didn't work, I guess the implementation of FOR EACH is not correct. I'm not sure if FOR EACH is the best code to use.
I appreciate anyone's help on this. Thank you very much! May the force be with you.
Try this:
Sub journalben()
Dim i As Long, lastRow As Long
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
lastRow = rawben.Cells(Rows.Count, "G").End(xlUp).Row
For i = 5 To lastRow
'test if cell is empty
If rawben.Range("G" & i).Value <> "" Then
finaljnl.Range("K" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("L" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
I am starting FOR from 5 as the data in your image starts from cell G5 (not considering the header).
It'll be easier to use a numeric variable for this :
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = rawben.Range("G4:G1048576")
For i = Rng.Cells(1,1).Row to Rng.Cells(1,1).End(xlDown).Row
'test if cell is empty
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("K" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
You should use a simple for loop. It is easier to work with.
Also, to have it dynamic and to go to the last cell in the range, use the SpecialCells method.
And your range needs to be set correctly from row 5.
Here is the code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G5:G1048576")
For i = Rng.Cells(1,1).Row to Rng.SpecialCells(xlCellTypeLastCell).Row
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & CStr(i - 1)).Value = rawben.Range("G" & CStr(i)).Value
finaljnl.Range("K" & CStr(i - 1)).Value = rawben.Range("L" & CStr(i)).Value
End If
Next i
End Sub

Change a cell's format to boldface if the value is over 500

I am using Excel 2010 and trying to add a bunch of rows placing the sum of columns A and B in column C. If the sum is over 500 I would then like to boldface the number in column C. My code below works works mathematically but will not do the bold formatting. Can someone tell me what I am doing wrong? Thank you.
Public Sub addMyRows()
Dim row As Integer 'creates a variable called 'row'
row = 2 'sets row to 2 b/c first row is a title
Do
Cells(row, 3).Formula = "=A" & row & "+B" & row 'the 3 stands for column C.
If ActiveCell.Value > 500 Then Selection.Font.Bold = True
row = row + 1
'loops until it encounters an empty row
Loop Until Len(Cells(row, 1)) = 0
End Sub
Pure VBA approach:
Public Sub AddMyRows()
Dim LRow As Long
Dim Rng As Range, Cell As Range
LRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("C2:C" & LRow)
Rng.Formula = "=A2+B2"
For Each Cell In Rng
Cell.Font.Bold = (Cell.Value > 500)
Next Cell
End Sub
Screenshot:
An alternative is conditional formatting.
Hope this helps.
Note: The formula in the block has been edited to reflect #simoco's comment regarding a re-run of the code. This makes the code safer for the times when you need to re-run it. :)

VBA Excel find and replace WITHOUT replacing items already replaced

I am looking to make an excel script that can find and replace data, but for the love of everything I cannot figure out how to write it.
Situation:
A-----------B-----------C
Cat-------Dog------Banana
Dog------Fish------Apple
Fish------Cat-------Orange
So the macro would look at the data in a cell in column B, then look at the adjacent cell in column C, and replace all instances of that data in column A with what if found in C. So the results would be:
A---------------B-----------C
Orange------Dog------Banana
Banana------Fish------Apple
Apple--------Cat-------Orange
But that's not all, I would like it to not change cells in A that already have been changed once! (I'm trying this with changing the background colour)
Any help? I am at a complete loss.
EDIT:
Okay I found out how to do the easy part (replacing), but I cannot find out how to not change cells that already have been changed once. Here is my code:
Sub multiFindNReplace()
Dim myList, myRange
Set myList = Sheets("sheet1").Range("A2:B3") 'two column range where find/replace pairs are
Set myRange = Sheets("sheet1").Range("D2:D5") 'range to be searched
For Each cel In myList.Columns(1).Cells
myRange.Replace what:=cel.Value, replacement:=cel.Offset(0, 1).Value, ReplaceFormat:=True
Next cel
End Sub
As far as I can tell, ReplaceFormat:=True
doesn't do anything ;/ so items that already have been replaced once still are being replaced! Is there a way to somehow make this work?
Here's the answer using your recommendation with color as a one-time limiter:
Sub Replace_Once()
'Find last row using last cell in Column B
LastRow = Range("B" & Rows.Count).End(xlUp).Row
'Clear colors in Column A
Range("A1:A" & LastRow).Interior.ColorIndex = xlNone
'Look at each cell in Column B one at a time (Cel is a variable)
For Each Cel In Range("B1:B" & LastRow)
'Compare the cell in Column B with the Value in Column A one at a time (C is a variable)
For Each C In Range("A1:A" & LastRow)
'Check if the Cell in Column A matches the Cell in Column B and sees if the color has changed.
If C.Value = Cel.Value And C.Interior.Color <> RGB(200, 200, 200) Then
'Colors the cell
C.Interior.Color = RGB(200, 200, 200)
'Updates the value in Column A with the cell to the right of the Cell in Column B
C.Value = Cel.Offset(0, 1).Value
End If
Next
Next
'Uncomment the line below to remove color again
'Range("A1:A" & LastRow).Interior.ColorIndex = xlNone
End Sub