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
Related
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
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 3 years ago.
Improve this question
How to create sequential numbers at end of a list with letters either side, It's always MW....A, so changing the middle number? can this be done using a button so when clicked these are created at the bottom of the list.
Thanks
Try this code, please:
It will add maxInc units to the existing startNo value, for the range starting from the lastRow row...
Sub testIncrementValString()
Dim sh As Worksheet, i As Long, lastRow As Long, startNo As Long, maxInc As Long
Set sh = ActiveSheet 'use here your sheet
maxInc = 10: startNo = 1670: lastRow = 155
For i = 1 To maxInc
sh.Range("A" & lastRow + i).Value = "MW" & startNo + i & "A"
Next i
End Sub
The code can be adapted to find the last number inside the string, of the last filled row of A:A column and add a unit, or how many you need for the following...
Like this:
Sub testIncrementValString_bis()
Dim sh As Worksheet, i As Long, lastRow As Long, startNo As Long, maxInc As Long
Set sh = ActiveSheet 'use here your sheet
lastRow = sh.Range("A" & sh.Rows.count).End(xlUp).Row
startNo = CLng(Mid(sh.Range("A" & lastRow).Value, 3, _
Len(sh.Range("A" & lastRow).Value) - 3))
maxInc = 10
For i = 1 To maxInc
sh.Range("A" & lastRow + i).Value = "MW" & startNo + i & "A"
Next i
End Sub
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 have a summary sheet Consolidated Tracker and data sheets that won't be set statically as they'll be dates i.e Sheet1 renamed May 2018 Sheet2 renamed October 2018 Sheet3 renamed May 2019 etc.
The follow code checks for a match in Column B across two statically set worksheets Consolidated Tracker and May 2018.
If a match is found, it takes the value from cell C4 in May 2018 and sets C4 in the Consolidated Tracker to this value.
What I'd next like to achieve is to check:
Sheet3 and Set D4 in the Consolidated Tracker if a match is found.
Sheet4 and set E4 in the Consolidated Tracker if a match is found.
Sheet5 and set F4 in the Consolidated Tracker if a match is found.
I've got this far by myself but I'm unsure how to procede from here.
Thank you.
Option Explicit
Public Sub UpdateData()
Dim WsDest As Worksheet 'destination workbook to write in
Set WsDest = ThisWorkbook.Worksheets("Consolidated Tracker")
Dim WsSrc As Worksheet 'source workbook to match with
Set WsSrc = ThisWorkbook.Worksheets("May 2018")
Dim LastRow As Long 'last used row in workbook
LastRow = WsDest.Cells(WsDest.Rows.Count, "B").End(xlUp).Row
Dim iRow As Long, MatchedRow As Long
For iRow = 1 To LastRow 'loop through all rows from row 1 to last used row and update each row
MatchedRow = 0 'initialize
On Error Resume Next 'if no match found then ignore error
MatchedRow = WorksheetFunction.Match(WsDest.Cells(iRow, "B"), WsSrc.Columns("B"), 0) 'get the row number of the match
On Error GoTo 0 'reactivate error reporting
If MatchedRow > 0 Then 'if a match was found then copy values
WsDest.Cells(iRow, "C").Value = WsSrc.Cells(MatchedRow, "C").Value
End If
Next iRow
End Sub
Does this do what you want?
It uses the sheet index but I'm uneasy about that because sheets can easily be re-ordered and your code will blow up.
As it stands the code will run through from the first to penultimate sheet (assuming your destination sheet is last) so you might need to adjust the j loop.
Public Sub UpdateData()
Dim WsDest As Worksheet 'destination workbook to write in
Set WsDest = ThisWorkbook.Worksheets("Consolidated Tracker")
Dim LastRow As Long 'last used row in workbook
LastRow = WsDest.Cells(WsDest.Rows.Count, "B").End(xlUp).Row
Dim iRow As Long, MatchedRow As Variant, j As Long, c As Long
c = 3
For j = 1 To Sheets.Count - 1
For iRow = 1 To LastRow 'loop through all rows from row 1 to last used row and update each row
MatchedRow = Application.Match(WsDest.Cells(iRow, "B"), Worksheets(j).Columns("B"), 0) 'get the row number of the match
If IsNumeric(MatchedRow) Then 'if a match was found then copy values
WsDest.Cells(iRow, c).Value = Worksheets(j).Cells(MatchedRow, "C").Value
End If
Next iRow
c = c + 1
Next j
End Sub
Here is a better method which doesn't rely on sheet indexes.
Public Sub UpdateData()
Dim WsDest As Worksheet 'destination workbook to write in
Set WsDest = ThisWorkbook.Worksheets("Consolidated Tracker")
Dim LastRow As Long 'last used row in workbook
LastRow = WsDest.Cells(WsDest.Rows.Count, "B").End(xlUp).Row
Dim iRow As Long, MatchedRow As Variant, c As Long, ws As Long
c = 3
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> WsDest.Name Then
For iRow = 1 To LastRow 'loop through all rows from row 1 to last used row and update each row
MatchedRow = Application.Match(WsDest.Cells(iRow, "B"), ws.Columns("B"), 0) 'get the row number of the match
If IsNumeric(MatchedRow) Then 'if a match was found then copy values
WsDest.Cells(iRow, c).Value = ws.Cells(MatchedRow, "C").Value
End If
Next iRow
c = c + 1
End If
Next ws
End Sub
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 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