Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 12 months ago.
Improve this question
I have 500 value in column A and 200 value in column B. I need to check that column A values are present in column B. if value is found then need to highlight that founded value.
This is my attempt. Your questions is pretty vague though, so there are a few assumptions. Good luck!
Sub compareColumns()
' im assuming the sheet in question is the index 1 sheet in the workbook
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
' im assuming no header
Dim lastRowA As Integer: lastRowA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim lastRowB As Integer: lastRowB = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
Dim i As Integer, j As Integer
Dim matchMe As String
For i = 1 To lastRowA
matchMe = ws.Cells(i, 1).Value
For j = 1 To lastRowB
If ws.Cells(j, 2).Value = matchMe Then
ws.Cells(i, 1).Interior.Color = vbRed
Exit For
End If
Next j
Next i
End Sub
Related
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 years ago.
Improve this question
I am trying to create a code that looks at column A in sheet1, then insert new lines in sheet2. Then paste the contents of column A (sheet1) into column A on sheet2. See attached pictures:
Sheet1 - total list
Sheet2 - existing list, need to add new lines from sheet1 and shift down the rest of contents.
Sheet3 - Result.
I do this manually every time but I am trying to make it automatic so I can save some time. I will assign a button to this.
Thanks in advance.
Nelson
enter image description here
enter image description here
enter image description here
try the code below :
Sub test()
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws = ThisWorkbook.Sheets("sheet1")
Set ws2 = ThisWorkbook.Sheets("sheet2")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
i = 1
Do While ws.Cells(i, 1).Value = ws2.Cells(i, 1).Value
i = i + 1
Loop
For j = i To lastRow
lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
ws2.Rows(lastRow2 + 1).EntireRow.Insert
ws2.Range("A" & lastRow2 + 1).Value = ws.Range("A" & j).Value
Next j
End Sub
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 4 years ago.
Improve this question
Columns A and G are OrderID, each with their own AMOUNT, Columns C and H.
If the OrderID columns match, I need to compare Columns C and H**.
If they are different, then highlight the cell. I want to use VBA for this as it's part of a larger Macro I want to add to.
You can try using below code, it will loop through all lines and compare column A with column G:G if its equal then compare C & H and if is not equal then change the colour index.
Code:
Dim Wb As Workbook, ws As Worksheet, lrow As Long, j As Long, m As Long, lrow2 As Long, Search As Variant, Search2 As Variant
Set Wb = ThisWorkbook
Set ws = Wb.Sheets("Sheet1")
lrow = ws.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
lrow2 = ws.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
For j = 3 To lrow
Search = (ws.Cells(j, 1).Value)
Search2 = (ws.Cells(j, 3).Value)
For m = 3 To lrow2
If ws.Cells(m, 7) = Search And ws.Cells(m, 8) <> Search2 Then
ws.Range("C" & j).Interior.ColorIndex = 3
ws.Range("H" & m).Interior.ColorIndex = 3
End If
Next
Next
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
I am attempting to accomplish the below task, please see the image for reference.
As you can see in columns C, D, and E, there is text such as X55.656 and Y922.495 respectively and so on. Now the problem I am facing is that the text with "X" should be placed in column X, and the text starting with "Y" should be placed in the Y column. This has to be done to all the rows containing X and Y. Can you write a VBA code for me from scratch to help solve my problem?
The Output should as shown in the below figure,
You do need to state how you want to handle X or Y occuring in more than one source column in the same row.
If you don't mind overwriting when X or Y occurs multiple times in a row you can use the following as a starting point:
Dim wb as workbook
Dim ws as worksheet
Dim LastRow as long
Dim rng as Range
Dim row as Range
Dim cell as Range
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheetname") 'change as appropriate
'Assuming column C, D and E have end items in the same row (otherwise consider finding lastrow using current region.
LastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).row
Set rng = ws.Range(ws.Cells(1, "C"), ws.Cells(LastRow, "E"))
For Each row in rng.Rows
For Each cell in row.cells
If Lcase(Left(cell.Value,1)) = "x" Then
If Mid(cell.Address, 2, 1) = "C" Then
cell.Offset(0, 21) = cell.Value
Elseif Mid(cell.Address, 2, 1) = "D" Then
cell.Offset(0, 20) = cell.Value
Else: cell.Offset(0, 19) = cell.Value
End If
cell.clearcontents
End If
If Lcase(Left(cell.Value,1)) = "y" Then
If Mid(cell.Address, 2, 1) = "C" Then
cell.Offset(0, 22) = cell.Value
Elseif Mid(cell.Address, 2, 1) = "D" Then
cell.Offset(0, 21) = cell.Value
Else: cell.Offset(0, 20) = cell.Value
End If
cell.clearcontents
End If
Next Cell
Next row
End Sub
Different ways of finding LastRow Finding LastRow
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 5 years ago.
Improve this question
I have two workbooks. A source Workbook(1) and an Destination Workbook(2).
I am copying all the Contents from 1 to 2.
I have the below code running for this.
I have a small problem with the workbook.
I have my source book with pictures in it , Like the picture below.
I have included the column to be copied in my code. but I don't get those pictures. Could someone tell me how I can copy these pictures with the contents to my destination sheet, with the below code.
Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim Val As Variant
Dim filename As String
Dim LastCell As Range
Dim LastRow As Long
ThisWorkbook.Sheets("2").Range("A4:P1000").ClearContents
CopyCol = Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P", ",")
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
LCell = Selection.SpecialCells(xlCellTypeLastCell).Address
LCC = Selection.SpecialCells(xlCellTypeLastCell).Column
LCR = Selection.SpecialCells(xlCellTypeLastCell).Row
Set y = ThisWorkbook ' set ThisWorkbook object (where this code lies)
Set x = Workbooks.Open("D:\Jenny\Raw data\Report.xlsx")
For Count = 0 To UBound(CopyCol)
Set temp = Range(CopyCol(Count) & "22:" & CopyCol(Count) & LCR)
If Count = 0 Then
Set CopyRange = temp
Else
Set CopyRange = Union(CopyRange, temp)
End If
Next
CopyRange.Copy
y.Sheets("2").Range("A4").PasteSpecial
x.Close
End Sub
Could someone suggest, how I can copy those picture with the content to the destination workbook.
Instead of
y.Sheets("2").Range("A4").PasteSpecial
try
y.Sheets("2").Paste y.Sheets("2").Range("A4")
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 6 years ago.
Improve this question
I'm writing a makro formatting all non-numeric cells to text before loading to database. I have a line that I have no idea what's wrong with. My VBA skills are poor. I get run-time error '424'.
Sub formatAllCellsAsText()
Dim wsTemp As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
For sht = 3 To Worksheets.Count
Set wsTemp = Sheets(sht)
Set StartCell = Range("A4")
LastRow = wsTemp.Range("A1").CurrentRegion.Rows.Count
LastColumn = wsTemp.Range("A1").CurrentRegion.Columns.Count
For Each Cell In wsTemp.Range(StartCell, wsTemp.Cells(LastRow, LastColumn)).Cells
If Not IsEmpty(Cell.Value) And IsNumeric(Cell.Value) And InStr(wsTemp.Cells(1, Cell.Column), "Client ID") <= 0 Then
Dim Temp As Double
Temp = Cell.Value
Cell.ClearContents
Cell.NumberFormat = "#"
Cell.Value = CStr(Temp)
End If
Next
Next sht
End Sub
Set StartCell = Range("A4")
should be
Set StartCell = wsTemp.Range("A4")
Just want to summarize as I probably found the issue.
In my first code posted I did not set Cell variable that I was later referring to. I thought that Cell would be self-explanatory for VBA.