I need help here. I have a spreadsheet that has more than 6K datas. I need to compare the values between the "MOVE_IN_QTY" and "MOVE_OUT_QTY" by using VBA. The problem here is I need to compare the value right after the code has changed from "CV64" and "TW78" in the code column. The value I have higlighted in red and the code I have highlighted in blue and yellow. I would appreciate any help. Thanks.
Making a few assumptions here:
Move In & Move Out are always numbers.
Move numbers are compered using the =,<,> process.
Unknown further action based on result is required.
Also it helps to include what you have tried and what is not working.
Sub ReviewData()
Dim wkbk As Workbook
Dim xsheet As Worksheet
Dim codeColumn As String, moveIN As String, moveOUT As String
Dim rowCount As Double
Set wkbk = ThisWorkbook
Set xsheet = wkbk.Worksheets("Sheet1") 'change sheet name here
codeColumn = "B" ' change column letter here
moveIN = "C" 'set move in column
moveOUT = "D" 'set move out column
'this will loop through the Code column until the last set of data.
rowCount = xsheet.Range(codeColumn & xsheet.Rows.Count).End(xlUp).Row 'find last row
For x = 2 To rowCount
'checks if code transitions from one code to another
If not xsheet.Range(codeColumn & x).Value = xsheet.Range(codeColumn & x + 1).Value Then
If xsheet.Range(moveIN & x).Value = xsheet.Range(moveOUT & x + 1).Value Then
'do something if the code is the same
Else
xsheet.Range(codeColumn & x).Interior.ColorIndex = 3
MsgBox ("Row: " & x & " is different") 'comment this out not to get the message
End If
Else
End If
Next x
End Sub
Related
I want to create a macro that inserts new column with column name (BL & Container) and then concatinates 2 column in newly inserted column.
In this column I named BL & Container is a new column added my macro.
Further I want the macro to concatenate the values present in column H and F macro should find column H and F by column name and concatenate the them in to newly inserted column I.
My codes below
Sub insert_conc()
Dim ColHe As Range
Dim FindCol As Range
Dim con As String
Dim x As Long
Set FindCol = Range("1:1") 'Looks in entire first row.
Set ColHe = FindCol.Find(what:="BL/AWB/PRO", After:=Cells(1, 1))
With ActiveWorkbook.Worksheets("WE")
ColHe.Offset(0, 1).EntireColumn.Insert
ColHe.Offset(0, 1).Value = "WER"
'x = Range("A" & Rows.Count).End(xlUp).Row
con = "=H2&""-""&F2"
ColHe.Resize(x - 1).Formula = con
End With
Application.ScreenUpdating = True
End Sub
[![Error in code][3]][3]
In this code line " con = "=H2&""-""&F2"" please advise how do I update column nameinstead of H2 and F2 macro should find columna H2 and F2 header name and then concatinate the values in newly inserted column I BL & container. Please advise.
Please, use the next adapted code:
Sub insert_conc()
Dim sh As Worksheet, x As Long, ColHe As Range
Dim FindCol As Range, con As String, firstCell As Range
Set sh = Worksheets("LCL")
x = sh.Range("A" & sh.rows.count).End(xlUp).row
Set FindCol = sh.Range("1:1") 'Looks in entire first row.
Set ColHe = FindCol.Find(what:="BL/AWB/PRO", After:=sh.cells(1, 1))
ColHe.Offset(0, 1).EntireColumn.Insert
ColHe.Offset(0, 1).value = "BL & Container"
Set firstCell = ColHe.Offset(1, -2) ' determine the cell to replace F2
con = "=" & ColHe.Offset(1).Address(0, 0) & "&" & firstCell.Address(0, 0)
ColHe.Offset(1, 1).Resize(x - 1).Formula = con
End Sub
It is also good to know that using With ActiveWorkbook.Worksheets("LCL") makes sense only if you use it in the code lines up to End with. And your code did not do that... It should be used before, in order to deal with the appropriate sheet, even if it was not the active one.
I have excel workbook and i need to compare column B and column W if column B & W data is the same need to copy an entire row to a newsheet(sheetname "Reconciled") column B data is date format like this (2020-02-01 07:55:08.0) column W date format is like this (27/01/2020) Column B & W need to compare with the date.
this code date is selected but it is working but it is wrong.
Sub runThrough(cbpath As String, bspath As String)
Dim newcashBook, newbankstmt As Worksheet
Dim cashbook, Bankstmt As Workbook
Dim i, j As Long
Dim cbRecords, bsRecords rng As String
Set cashbook = Workbooks.Open(cbpath)
'copy data from another workbook
Set newcashBook = cashbook.Sheets(1)
newcashBook.Range("A1:Z1048576").Copy
cashbook.Close
'paste data to W1 row from another workbook
Set newbankstmt = ThisWorkbook.Sheets("Sheet0")
newbankstmt.Range("W1").PasteSpecial
For i = 2 To 100
Set newbankstmt = ThisWorkbook.Sheets("Sheet0")
' Sheet0 is activeworkbook active worksheet
Rows.Cells(i, 2).Select
Rows.Cells(i, 2).Select
For j = 2 To 100
Rows.Cells(j, 31).Select
If (i = j) Then
Debug.Print "yes" 'check data same or not
Else
Debug.Print "wrong"
End If
Next j
Next i
End Sub
The below check if both date are valid and check if there are the same. Modify and use:
Sub populate_sales()
Dim bDate As Date, wDate As Date
With ThisWorkbook.Worksheets("Sheet1")
'Check if both date are valid
If IsDate(.Range("B1").Value) And IsDate(.Range("W1").Value) Then
bDate = Year(.Range("B1").Value) & "-" & Right("0" & Month(.Range("B1").Value), 2) & "-" & Right("0" & Day(.Range("B1").Value), 2)
wDate = Year(.Range("W1").Value) & "-" & Right("0" & Month(.Range("W1").Value), 2) & "-" & Right("0" & Day(.Range("W1").Value), 2)
If bDate = wDate Then
'Copy
End If
Else
MsgBox "Invalid dates"
End If
End With
End Sub
I prepared a code based on what I could deduce from your question and comments. So, the code copy, as fast as possible (using array) the content of cashbook.Sheets(1) in newbankstmt.Range("W1").
Then it iterates between 100 rows and, if "B" cell Date on a specific row is equal with the "W" cell Date of the same row, then the rage "A:W" address of the respective row is returned in Immediate Window and the code is stopped. You can go to the next such occurrence pressing F5. In order to see the returned value in Immediate Window, you must press Ctrl + G.
If this is what you needed, please confirm and I will show you how that ranges can be also loaded in another array and paste at once in a new sheet, or wherever you need, if clearly explain where...
This code doesn't care about the cell (date) format. But, the code would work only if both cells in discussion (B and W) are of Date type.
Sub runThrough(cbpath As String, bspath As String)
Dim newcashBook As Worksheet, newbankstmt As Worksheet
Dim cashbook As Workbook, Bankstmt As Workbook
Dim i As Long, dateB As Date, dateW As Date, arrC As Variant
Set cashbook = Workbooks.Open(cbpath)
'copy data from cashbook:
Set newcashBook = cashbook.Sheets(1)
'input the big range in arrC array:
arrC = newcashBook.Range("A1:Z1048576").value
cashbook.Close
'copy the arrC content starting from W1:
Set newbankstmt = ThisWorkbook.Sheets("Sheet0")
newbankstmt.Range("W1").Resize(UBound(arrC, 1), UBound(arrC, 2)).value = arrC
For i = 2 To 100 'why To 100?
dateB = newbankstm.Cells(i, "B").value
dateW = newbankstm.Cells(i, "W").value
If DateSerial(Year(dateB), Month(dateB), Day(dateB)) = DateSerial(Year(dateW), Month(dateW), Day(dateW)) Then
Debug.Print "Range to be copied: " & newbankstm.Range(newbankstm.Cells(i, 1), _
newbankstm.Cells(i, "W")).Address
Stop
End If
Next i
End Sub
I just need to be able to match if id numbers in the "A" column of sheet 1 match in the respective "A" column of sheet 2, and just paste the matches to column "A" in sheet 3. The column range in sheet 1 is not the same range as sheet 2, and sheet 3 needs to have the matches pasted in each row as they are found (i.e. no blank rows in between). I DO NOT need to do anything about numbers that do not match.
I have attempted to modify code from a different thread. It catches some matches, but not all. I guess the ranges are incorrect but I don't really know how to code that in VBA. Plus there are spaces in the column where some of the other duplicates should be posted. The "if found is nothing then x = 0" is unnecessary (and may even be causing the aforementioned error), but if I take that out I get a type mismatch error.
Sub matchPAs()
Dim x, i, total, fRow As Integer
Dim found As Range
total = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To total
match1 = Worksheets(1).Range("A" & i).Value
Set found = Sheets(2).Columns("A:A").Find(what:=match1)
If found Is Nothing Then
x = 0
Else
fRow = Sheets(2).Columns("A:A").Find(what:=match1).Row
Worksheets(3).Range("A" & i).Value = Worksheets(1).Range("A" & fRow).Value
End If
Next i
End Sub
the logic is a little off:
Sub matchPAs()
Dim total As Long
total = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
Dim i As Long
For i = 1 To total
Dim match1 As Variant
match1 = Worksheets(1).Range("A" & i).Value
Dim found As Range
Set found = Sheets(2).Columns("A:A").Find(what:=match1)
If Not found Is Nothing Then
Worksheets(3).Range("A" & Rows.Count).End(xlUp).Offset(1).Value = match1
End If
Next i
End Sub
I'm working on a planning monitoring tool. I need to lock a range of cells based on a cell value.
I would like when the value in column "Q" is "Confirmed", then cells on the same row from Column M to Q are locked.
Sub planning_blocker()
Dim last_row As Integer
' Compute the last row
last_row = Worksheets("Planning").Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print last_row
For i = 3 To last_row
If Worksheets("Planning").Cells(i, 17).Value = "" Then
Sheets("Planning").Range("M" & i & ":" & "P" & i).Locked = False
Else
Sheets("Planning").Range("M" & i & ":" & "P" & i).Locked = True
End If
Next i
Sheets("Planning").Protect Password:="User"
End Sub
This works partially because:
it locks the entire row where "confirmed" is detected and not only the range
it consider only the first row where "confirmed" is detected and not the remaining ones (if more than one row is marked with "confirmed", only the first row is blocked).
i tested your code and it works for me (Excel2016). the ranges (M:P) are locked if 17th column (col Q) of current row isn't empty. don't no what could be your problem here...
Well, if you need to watch the status column for changes, I would suggest to use the Sub Worksheet_Change. this will trigger your code every time something changes in your sheet.
I made some changes to adapt your code and here is the result:
Sub Worksheet_Change(ByVal target As Range)
Dim intesection As Range
Dim rowIndex As Integer
Set intesection = Intersect(target, Range("Q:Q"))
'watch changes in intersection (column Q)
If Not intesection Is Nothing Then
'get row index of changed status
rowIndex = Range(intesection.Address(0, 0)).Row
If Cells(rowIndex, 17).Value = "" Then
'unlock if status is blank
ActiveSheet.Range("M" & rowIndex & ":" & "P" & rowIndex).Locked = False
Call ActiveSheet.Protect(UserInterfaceOnly:=True, Password:="User")
Else
'lock if not blank
ActiveSheet.Range("M" & rowIndex & ":" & "P" & rowIndex).Locked = True
Call ActiveSheet.Protect(UserInterfaceOnly:=True, Password:="User")
End If
End If
End Sub
And you need to add this to the sheet where you have the table you want to lock/unlock.
Something like this:
Sources:
How to Lock the data in a cell
How to Tell if a Cell Changed
So I have a VBA that is suppose to copy the on the "data" sheet and paste it on the "Internal Use" via searching a cell on cell in the "Internal Use" I'm not getting an error it is just not doing it and it after I run the macro it just stays on the "data" sheet.
What am I missing?
Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If
Next Row
End Sub
Hard to tell what you're trying to do. Let me know if this is what you want.
Sub CommandButton2_Click()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim nr As Long
Dim project As Variant
Set ws1 = ThisWorkbook.WorkSheets("Internal Use")
Set ws2 = ThisWorkbook.WorkSheets("data")
project = ws1.Range("C4").Value2
With ws1
nr = .Range("A" & .Rows.Count).End(xlUp).Row
For r = 2 To nr
If .Range("F" & r) = project Then
ws2.Range("Q" & r) = .Range("C7")
End If
Next
End With
End Sub
Ricardo,
Your code is working fine. Question is what are you trying to accomplish? If you are trying to paste on 'Internal Use' sheet, you need to activate it. I have added a line to activate it. Please be more specific on what you want to accomplish.
Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Internal Use").Activate
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If
Next Row
End Sub
You want to populate column Q on the data sheet with the value from Worksheet Internal Use cell C7, whenever column F on the same row is equal to cell C4.
I have to say that that's easily solvable with a formula using index match or a conditional formula like =If(F2='Internal Use'!$C$4,'Internal Use'!$C$7,"") (Just paste in column F). At least this is what your code currently more or less does or seems to want to achieve.
That said let's take a look at your code:
First of all avoid .Activate, it's unnecessary overhead. This will activate the worksheet. (By the way, the last .activate you use, is on the data worksheet, hence it stays there) Next you store C4 in an undeclared variable called project that you never use.
Next you reference the cells everywhere in the loop again. This means there is huge overhead on accessing and reading out these cells. Lastly you do this in a loop; I assume this is to avoid filling up any of the other rows.
To make your code work, you could use:
Sub CommandButton2_Click()
Dim project as string
Dim writeValue as string
Dim lr as long
Dim wr as long
project = Worksheets("Internal Use").Range("C4").value
writeValue = Worksheets("data").Range("C7").value
lr = Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("data")
For wr = 2 To lr
If .Range("F" & wr).value = project Then
.Range("Q" & rw).value = writeValue
End If
Next wr
End With
End Sub
This will do the trick.
Neater would be to avoid the for loop and testing all cells. Two options are putting the entire F and Q columns into arrays and loop through those simultaniously while altering the Q-array before dumping the values back in the sheet, or use a Find-algorithm such as Chip Pearons FindAll: http://www.cpearson.com/excel/findall.aspx