Hi,
Im trying to achieve the following.
There is a table with 2 columns: groupID and limitvalue. For each groupid, I want to check if there are multiple, meaning more than one row (so checking if the next cell has same value) and if there are multiple IDs for that groupID number, check if there is any 3 dollar limit under LimitValue column on any of the cells for that particular groupid. if 3 dollar limit along with other limit values are found, put a check mark for the entire rows for that groupID. If there is No $3 limit found or all limits are $3, do not put check. In reality, there are 100,000+ rows which is why I need macro to do the work.
I have posted excel table in the link below for the better visualization. First 2 blue columns are the input and the 3rd (yellow) column is the output where we put check mark according to the category.
http://i62.tinypic.com/2j1rl0z.png
Below is my code in work. It's currently not returning checks where it should return. I appreciate your help.
Sub DuplicateLimitsOtherThanThree()
Dim wsMain As Worksheet, wsOutput As Worksheet
Dim lRowColA As Long, lRowColB As Long, i As Long, j As Long
Dim aCell As Range, ColARng As Range, ColBRng As Range
Dim strOtherLimit As String
Dim reFill As Long
Dim k As Long
Dim lastRow As Long
'~~> Set input Sheet and output sheet
Set wsMain = ThisWorkbook.Sheets("Data_base")
Set wsOutput = ThisWorkbook.Sheets("Test")
strOtherLimit = ""
j = 2
k = j
With wsMain
'~~> Get last row in Col A & B
lRowColA = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Set your actual data range in Col A and B
Set ColARng = .Range("A2:A" & lRowColA)
'~~> Loop through Col A
For i = 2 To lRowColA
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
'~~> Check if there are duplicates of Col A value in Col B
'If Application.WorksheetFunction.CountIf(ColARng, .Range("A" & i).Value) > 0 Then
'If Application.WorksheetFunction.CountIf(ColARng, .Range("A" & i + 1).Value) > 0 Then
If .Range("A" & i).Value > 0 Then
If .Range("A" & i + 1).Value > 0 Then
If .Range("A" & i).Value = .Range("A" & i + 1).Value Then
wsOutput.Cells(j, 8).Value = .Range("A" & i).Value
wsOutput.Cells(j, 9).Value = .Range("E" & i).Value
If .Range("E" & i).Value <> 3 Then
strOtherLimit = "v"
End If
j = j + 1
Else
If .Range("A" & i).Value = .Range("A" & i - 1).Value Then
wsOutput.Cells(j, 8).Value = .Range("A" & i).Value
wsOutput.Cells(j, 9).Value = .Range("E" & i).Value
' If .Range("E" & i - 1).Value <> 3 Then
If .Range("E" & i).Value <> 3 Then
strOtherLimit = "v"
End If
For reFill = k To j
wsOutput.Cells(reFill, 10).Value = strOtherLimit
Next reFill
j = j + 1
strOtherLimit = ""
k = j
End If
End If
Else
'We are at the end of the worksheet
If .Range("A" & i).Value = .Range("A" & i - 1).Value Then
wsOutput.Cells(j, 8).Value = .Range("A" & i).Value
wsOutput.Cells(j, 9).Value = .Range("E" & i).Value
If .Range("E" & i - 1).Value <> 3 Then
strOtherLimit = "YES"
End If
For reFill = k To j
wsOutput.Cells(reFill, 10).Value = strOtherLimit
Next reFill
j = j + 1
strOtherLimit = "NO"
k = j
End If
End If
End If
End If
lastRow = i
Next i
End With
End Sub
Im trying to achieve the following.
There is a table with 2 columns: groupID and limitvalue. For each groupid, I want to check if there are multiple, meaning more than one row (so checking if the next cell has same value) and if there are multiple IDs for that groupID number, check if there is any 3 dollar limit under LimitValue column on any of the cells for that particular groupid. if 3 dollar limit along with other limit values are found, put a check mark for the entire rows for that groupID. If there is No $3 limit found or all limits are $3, do not put check. In reality, there are 100,000+ rows which is why I need macro to do the work.
I have posted excel table in the link below for the better visualization. First 2 blue columns are the input and the 3rd (yellow) column is the output where we put check mark according to the category.
http://i62.tinypic.com/2j1rl0z.png
Below is my code in work. It's currently not returning checks where it should return. I appreciate your help.
Sub DuplicateLimitsOtherThanThree()
Dim wsMain As Worksheet, wsOutput As Worksheet
Dim lRowColA As Long, lRowColB As Long, i As Long, j As Long
Dim aCell As Range, ColARng As Range, ColBRng As Range
Dim strOtherLimit As String
Dim reFill As Long
Dim k As Long
Dim lastRow As Long
'~~> Set input Sheet and output sheet
Set wsMain = ThisWorkbook.Sheets("Data_base")
Set wsOutput = ThisWorkbook.Sheets("Test")
strOtherLimit = ""
j = 2
k = j
With wsMain
'~~> Get last row in Col A & B
lRowColA = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Set your actual data range in Col A and B
Set ColARng = .Range("A2:A" & lRowColA)
'~~> Loop through Col A
For i = 2 To lRowColA
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
'~~> Check if there are duplicates of Col A value in Col B
'If Application.WorksheetFunction.CountIf(ColARng, .Range("A" & i).Value) > 0 Then
'If Application.WorksheetFunction.CountIf(ColARng, .Range("A" & i + 1).Value) > 0 Then
If .Range("A" & i).Value > 0 Then
If .Range("A" & i + 1).Value > 0 Then
If .Range("A" & i).Value = .Range("A" & i + 1).Value Then
wsOutput.Cells(j, 8).Value = .Range("A" & i).Value
wsOutput.Cells(j, 9).Value = .Range("E" & i).Value
If .Range("E" & i).Value <> 3 Then
strOtherLimit = "v"
End If
j = j + 1
Else
If .Range("A" & i).Value = .Range("A" & i - 1).Value Then
wsOutput.Cells(j, 8).Value = .Range("A" & i).Value
wsOutput.Cells(j, 9).Value = .Range("E" & i).Value
' If .Range("E" & i - 1).Value <> 3 Then
If .Range("E" & i).Value <> 3 Then
strOtherLimit = "v"
End If
For reFill = k To j
wsOutput.Cells(reFill, 10).Value = strOtherLimit
Next reFill
j = j + 1
strOtherLimit = ""
k = j
End If
End If
Else
'We are at the end of the worksheet
If .Range("A" & i).Value = .Range("A" & i - 1).Value Then
wsOutput.Cells(j, 8).Value = .Range("A" & i).Value
wsOutput.Cells(j, 9).Value = .Range("E" & i).Value
If .Range("E" & i - 1).Value <> 3 Then
strOtherLimit = "YES"
End If
For reFill = k To j
wsOutput.Cells(reFill, 10).Value = strOtherLimit
Next reFill
j = j + 1
strOtherLimit = "NO"
k = j
End If
End If
End If
End If
lastRow = i
Next i
End With
End Sub