I have 2 Excel sheets, I need to take 1 value in Sheet 1, look for it in Sheet 2. If I find it, then I need to make sure that some other values are matching. If yes, I copy the sheet 1 row in a "match" tab.
If not, I copy the row in "mismatch" tab and I need to insert a message that says which value didn't match.
I cannot make it work right now. I think I'm not exiting the loop in the right place. Here is my code. If anybody could help, I would appreciate.
Sub compareAndCopy()
Dim LastRowISINGB As Integer
Dim LastRowISINNR As Integer
Dim lastRowM As Integer
Dim lastRowN As Integer
Dim foundTrue As Boolean
Dim ErrorMsg As String
' stop screen from updating to speed things up
Application.ScreenUpdating = False
'Find the last row for column F and Column B from Sheet 1 and Sheet 2
LastRowISINGB = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "f").End(xlUp).row
LastRowISINNR = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "b").End(xlUp).row
'fIND THE LAST ROW OF MATCH AND MISMATCH TAB
lastRowM = Sheets("mismatch").Cells(Sheets("mismatch").Rows.Count, "f").End(xlUp).row + 1
lastRowN = Sheets("match").Cells(Sheets("match").Rows.Count, "f").End(xlUp).row + 1
'ISIN MATCH FIRST
For I = 2 To LastRowISINGB
For J = LastRowISINNR To 2 Step -1
If Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
Worksheets("Sheet1").Range("B" & I).Value = "Y" And _
Worksheets("Sheet2").Range("Z" & J).Value = "" And _
(Worksheets("Sheet1").Range("c" & I).Value = Worksheets("Sheet2").Range("AF" & J).Value Or _
Worksheets("Sheet1").Range("K" & I).Value = Worksheets("Sheet2").Range("K" & J).Value Or _
Worksheets("Sheet1").Range("N" & I).Value = Worksheets("Sheet2").Range("L" & J).Value) Then
Sheets("Sheet1").Rows(I).Copy Destination:=Sheets("match").Rows(lastRowN)
lastRowN = lastRowN + 1
Exit For
ElseIf Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
Worksheets("Sheet1").Range("B" & I).Value = "Y" And _
Worksheets("Sheet2").Range("Z" & J).Value = "" And _
Worksheets("Sheet1").Range("c" & I).Value <> Worksheets("Sheet2").Range("AF" & J).Value And _
Worksheets("Sheet1").Range("K" & I).Value <> Worksheets("Sheet2").Range("K" & J).Value And _
Worksheets("Sheet1").Range("N" & I).Value <> Worksheets("Sheet2").Range("L" & J).Value Then
ErrorMsg = "dates don't match"
ElseIf Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
Worksheets("Sheet1").Range("B" & I).Value <> "Y" Then
ErrorMsg = "B column don't match"
ElseIf Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
Worksheets("Sheet1").Range("B" & I).Value = "Y" And _
Worksheets("Sheet2").Range("Z" & J).Value <> "" Then
ErrorMsg = "Z column don't match"
Else: ErrorMsg = "ISIN don't match"
End If
Next J
Sheets("Sheet1").Rows(I).Copy Destination:=Sheets("mismatch").Rows(lastRowM)
Worksheets("mismatch").Range("S" & lastRowM).Value = ErrorMsg
lastRowM = lastRowM + 1
Next I
' stop screen from updating to speed things up
Application.ScreenUpdating = True
End Sub
First, I think you should add "Exit For" for each clause in If..else method. Otherwise it will lead to the fact that almost of your "miss match" result will be "ISIN don't match".
Second, I think you should set ErrorMsg = "" before For J = LastRowISINNR To 2 Step -1, and have condition ErrorMsg <> "" when you input result in sheet miss match.
Sheets("Sheet1").Rows(I).Copy Destination:=Sheets("mismatch").Rows(lastRowM)
Worksheets("mismatch").Range("S" & lastRowM).Value = ErrorMsg
lastRowM = lastRowM + 1
Otherwise, all your row even match or missmatch will input into miss match sheet.
Related
I need to categorize my data into different buckets. my worksheet has column V & Column Y (actually a name match & address match respectively) has values that are either "ok" or "check". Column O has IDs, of which some are only numeric and some are alpha numeric.i need to fill my column A based on these 3 columns.
category 1 - Column A to be filled with "Verify name & Address" - logic for this is - If Column A is blank, Column V value = "check", Column Y value = "check" and column O = all alphanumeric IDs (except that starts with CWT) and numeric IDs = 2 & 9612
Category 2 - Column A to be filled with "Verify Address" - logic for this is - If Column A is blank, Column V value = "ok", Column Y value = "check" and column O = all alphanumeric IDs (except that starts with CWT) and numeric IDs = 2 & 9612.
Sub Rules()
'
'Autofill based on Rules
Worksheets("ORD_CS").Activate
Dim sht As Worksheet
Dim LR As Long
Dim i As Long
Set sht = ActiveWorkbook.Worksheets("ORD_CS")
LR = sht.UsedRange.Rows.Count
With sht
For i = 8 To LR
If .Range("A" & i).Value = "" And Range("V" & i).Value = "check" And Range("Y" & i).Value = "check" And Range("O" & i).Value = "2" And Range("O" & i).Value = "9612" Then
.Range("D" & i).Value = "Verify Name & Address"
End If
Next i
End With
End Sub
I have not completed my code. Can someone help? Thanks
The below should work, I changed your O column to be an OR
Edit: for function
Public Function IsAlpha(strValue As String) As Boolean
Dim intPos As Integer
For intPos = 1 To Len(strValue)
Select Case Asc(Mid(strValue, intPos, 1))
Case 65 To 90, 97 To 122
IsAlpha = True
Case Else
IsAlpha = False
Exit For
End Select
Next
End Function
With sht
For i = 8 To LR
If .Range("A" & i).Value = "" And Range("V" & i).Value = "check" And Range("Y" & i).Value = "check" And Range("O" & i).Value = "2" Or Range("O" & i).Value = "9612" Or IsAlpha(Range("O" & i).Value) = True Then
.Range("D" & i).Value = "Verify Name & Address"
Else
If .Range("A" & i).Value = "" AND .Range("V" & i).Value = "ok" AND .Range("O" & i).Value = "2" Or .Range("O" & i).Value = "9612" Then
Do Stuff
End If
End If
Next i
End With
I am attempting to write some VBA that will accomplish
if row O is not null then copy all data to new row, then in current row clear columns I, J, K, L, M, N
in the newly inserted row clear columns O
The caveat I am not sure to account for is - throws a
Type mismatch error
Here is the syntax that I am trying to work with
Sub BlueBell()
Application.ScreenUpdating = False
Dim i As Long, y
ReDim y(2 To Range("A" & Rows.Count).End(3).Row)
For i = UBound(y) To LBound(y) Step -1
If Cells(i, "O") Then
If Cells(i, "I") = "" And Cells(i, "K") = "" And Cells(i, "M") = "" Then
GoTo DoNothing
Else
Rows(i).Copy
Cells(i, "A").Insert
Range("I" & i & ":J" & i & ":K" & i & ":L" & i & ":M" & i & ":N" & i & ":O" & i + 1).ClearContents
GoTo DoNothing
End If
End If
DoNothing:
Next i
End Sub
Apart from your error with using a string as a boolean expression, there are several things that can be changed in your code:
Sub BlueBell()
Application.ScreenUpdating = False
Dim i As Long ', y() As Variant
'ReDim y(2 To Range("A" & Rows.Count).End(3).Row) 'Why use an array?
For i = Range("A" & Rows.Count).End(3).Row To 2 Step -1
If Not IsEmpty(Cells(i, "O").Value) Then
'Avoid the use of GoTo
If Cells(i, "I").Value <> "" Or _
Cells(i, "K").Value <> "" Or _
Cells(i, "M").Value <> "" Then
Rows(i).Copy
Cells(i, "A").Insert
'Don't use a "Ix:Jx:Kx:Lx:Mx:Nx:Ox+1" range - it will lead to problems
'because even really experienced users don't understand what it does
Range("I" & i & ":N" & i).ClearContents
Range("O" & i + 1).ClearContents
End If
End If
Next i
'It's a good habit to reset anything that you disabled at the start of your code
Application.ScreenUpdating = True
End Sub
I'm trying to create a Macro that will modify contents in columns S, W and AH based on the content in AB
e.g. if AB1 = No, then S1=C-MEM, AH = N/A and W is cleared.
For some reason, I get a 'Type mismatch' error on the first line of my if statement and can't figure out why or how to fix it - even after reading other posts about similar issue.
Sub test()
Dim lastrow As Long
Dim i As Long
lastrow = Range("AB" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
**-> If Range("AB" & i).Value = "No" Then
Range("S" & i).Value = "C-MEM"
Range("W" & i).Value = ""
Range("AH" & i).Value = "N/A"
End If
Next i
End Sub
Thanks
You are trying to test if an error is = No.
Test for the error and skip the logic in that loop:
Sub test()
Dim lastrow As Long
Dim i As Long
lastrow = Range("AB" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Not IsError(Range("AB" & i).Value) Then
If Range("AB" & i).Value = "No" Then
Range("S" & i).Value = "C-MEM"
Range("W" & i).Value = ""
Range("AH" & i).Value = "N/A"
End If
End If
Next i
End Sub
I am working on a macro to loop through staggered columns of strings and concatenate them. Basically data gets added into the columns over time so I need to make it "future-proof". At the moment it picks up all of column H and I but only the first value of J and K. Not sure why it works for half but not the other. I am thinking its to do with my .End(xldown) as i am used to using rows.end(xlup).count to loop through things, but never when it is part of the range?
Here is my code:
Sub Concatenation_for_the_nation()
Range("H2").End(xlDown).Select
For i = 1 To ActiveCell.Row
Range("H" & i).Select
StrStrONE = StrStrONE & " " & Selection
Next i
Cells(1, 1).Select
Range("I2").End(xlDown).Select
For j = 1 To ActiveCell.Row
Range("I" & j).Select
StrStrTWO = StrStrTWO & " " & Selection
Next j
Cells(1, 1).Select
Range("J2").End(xlDown).Select
For k = 1 To ActiveCell.Row
Range("J" & k).Select
StrStrTHREE = StrStrTHREE & " " & Selection
Next k
Cells(1, 1).Select
Range("K2").End(xlDown).Select
For l = 1 To ActiveCell.Row
Range("K" & l).Select
StrStrFOUR = StrStrFOUR & " " & Selection
Next l
Cells(1, 1).Select
Cells(21, 21) = StrStrONE & StrStrTWO & StrStrTHREE & StrStrFOUR
Cells(20, 20) = "Jeff"
MsgBox "steve the pirate"
End Sub
You're repeating the same logic multiple times, so it makes sense to pull it out into a separate Sub.
Tested:
Sub Concatenation_for_the_nation()
Dim c As Range, s As String, sht As Worksheet
Set sht = ActiveSheet
For Each c In sht.Range("H1:K1")
s = s & ColumnString(c)
Next c
sht.Cells(21, 21).Value = s
sht.Cells(20, 20).Value = "Jeff"
MsgBox "arrrrr"
End Sub
Function ColumnString(cStart As Range, Optional sep As String = " ")
Dim rng As Range, c As Range, rv As String
Set rng = cStart.Parent.Range(cStart, _
cStart.Parent.Cells(Rows.Count, cStart.Column).End(xlUp))
For Each c In rng.Cells
rv = rv & sep & c.Value
Next c
ColumnString = rv
End Function
I have some code which is designed to scan Columns F & G for occurrences of words found in an array, the array containing text found in Column J. If it finds occurrences in either Column F or Column G, it will copy and paste the terms into the corresponding columns.
Column J contains free text from a field in SAP. The field is free text so it could be "Kerry John Pub Expenses" or "CATS O/H Kerry John", or even "CATS John Kerry O/H". There is no data entry standard for this field; this is what makes this task difficult .
Column F and Column G contains first names and last names. The code makes an assumption, if it finds an entry in column F or G that matches an entry in the txt array, it will copy and paste that entry.
During testing, the code proved not sufficient to match the outcomes which I was looking for, and the solution to this problem would be to match text in Columns F and G concurrently for two matching words rather than doing them in separate intervals.
I would like some suggestions as to how this code could be re-written to achieve this result.
Example of successful code run
Here we have 4 rows of data, John Citizen is located in Row 3, therefore the blank cells in Columns F and G, Row 2 can be populated with his first and last name.
The problem
Because I have two rows that contain Kerry Citizen and John Kerry, the row is populated with Kerry Kerry as a result, where the entry should be "John" in Column F and "Kerry" in Column G
Code starts here
Sub arraycolumnmatch()
Dim txtArray As Variant, T As Variant
Dim I As Long, J As Long
For I = 2 To Range("E50000").End(xlUp).row
typ = Range("F" & I).Value
If typ = "" Then
txt = Range("J" & I).Value
txtArray = Split(txt, " ")
For Each T In txtArray
For J = 2 To Range("F50000").End(xlUp).row
If Range("F" & J).Value = T Then
match_txt = T
Range("F" & I).Value = match_txt
End If
Next J
Next T
For Each T In txtArray
For J = 2 To Range("G50000").End(xlUp).row
If Range("G" & J).Value = T Then
match_txt = T
Range("G" & I).Value = match_txt
End If
Next J
Next T
End If
Next I
End Sub
You can simplify your code greatly, and make it work, like this:
typ = Range("F" & I).Value
If typ = "" Then
txt = Range("J" & I).Value
matchFound = False
For J = 2 To Range("G50000").End(xlUp).Row
If InStr(txt, Range("F" & J).Value) <> 0 _
And InStr(txt, Range("G" & J).Value) _
And Not (IsEmpty(Range("F" & J).Value)) _
And Not (IsEmpty(Range("G" & J).Value)) Then
'Both names match. Copy them.
Range("F" & I).Value = Range("F" & J).Value
Range("G" & I).Value = Range("G" & J).Value
matchFound = True
Exit For ' look no further.
End If
Next J
If Not matchFound Then MsgBox "No match found for: " & txt
End If
Tested, works for me.
The Code below runs for every first name on the list but only adds the name if both names match.
Sub arraycolumnmatch()
Dim txtArray As Variant, t As Variant
Dim I As Long, J As Long
For I = 2 To Range("G50000").End(xlUp).Row
typ = Range("F" & I).Value
If typ = "" And Not Range("J" & I).Value = Empty Then
txt = Range("J" & I).Value
txtArray = Split(txt, " ")
For Each word In txtArray
If Not word = "" Then
Set findtext = Range("F:F").Find _
(what:=(word), LookIn:=xlValues)
stoploop = False
loopcnt = 0
Do While Not findtext Is Nothing And stoploop = False And loopcnt < 21
loopcnt = loopcnt + 1
If InStr(txt, Range("F" & findtext.Row).Value) <> 0 _
And InStr(txt, Range("G" & findtext.Row).Value) Then
'Both names match. Copy them.
Range("F" & I).Value = Range("F" & findtext.Row).Value
Range("G" & I).Value = Range("G" & findtext.Row).Value
stoploop = True
Exit For ' look no further.
Else
Set findtext = Range("F" & findtext.Row & ":F" & 50000).Find _
(what:=(word), LookIn:=xlValues)
End If
Loop
End If
Next word
If Not stoploop Then MsgBox "No match found for: " & txt
End If
Next I
End Sub
Edit: Did an integration of #Jean InStr and a Find in Range which would allow for less loop time and a double match find.
I have had to stick with my original syntax, answer is below. Not the most efficient way of reaching the result, but it works
Sub arraycolumnmatch()
Dim txtArray As Variant, T As Variant
Dim I As Long, J As Long
For I = 2 To Range("E50000").End(xlUp).row
typ = Range("F" & I).Value
If typ = "" Then
txt = Range("J" & I).Value
txtArray = Split(txt, " ")
For Each T In txtArray
For J = 2 To Range("G50000").End(xlUp).row
If Range("G" & J).Value = T Then
match_txt = T
Range("G" & I).Value = match_txt
Exit For
End If
Next J
Next T
For Each T In txtArray
For J = 2 To Range("F50000").End(xlUp).row
If Range("F" & J).Value = T Then
match_txt = T
If Not Range("G" & I).Value = T Then
Range("F" & I).Value = match_txt
Exit For
End If
End If
Next J
Next T
End If
Next I