Column Match
Istarted to use C1 and then changed to using just C. I forgot to change some
of the C1 code.
Sub ColumnMatch()
Application.ScreenUpdating = False
NewRow = 1
Set ws1 = Sheets("R1")
With ws1
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
A_Data = .Range("A" & RowCount)
B_Data = .Range("B" & RowCount)
FirstNewRow = NewRow
Set c = .Columns("C").Find(what:=A_Data, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddr = c.Address
Do
C_Data = .Range("C" & RowCount)
D_Data = .Range("D" & RowCount)
With Sheets("Final")
.Range("A" & NewRow) = A_Data
.Range("B" & NewRow) = B_Data
.Range("C" & NewRow) = C_Data
.Range("D" & NewRow) = D_Data
NewRow = NewRow + 1
End With
Set c = .Columns("C").FindNext(after:=c)
Loop While Not c Is Nothing And c.Address < firstAddr
End If
Set c = .Columns("E").Find(what:=A_Data, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddr = c.Address
Do
E_Data = .Range("E" & RowCount)
F_Data = .Range("F" & RowCount)
G_Data = .Range("G" & RowCount)
With Sheets("Final")
If FirstNewRow RowCount Then
.Range("A" & FirstNewRow) = A_Data
.Range("B" & FirstNewRow) = B_Data
End If
.Range("E" & FirstNewRow) = E_Data
.Range("F" & FirstNewRow) = F_Data
.Range("G" & FirstNewRow) = G_Data
FirstNewRow = FirstNewRow + 1
End With
Set c = .Columns("E").FindNext(after:=c)
Loop While Not c Is Nothing And c.Address < firstAddr
End If
Next RowCount
End With
Application.ScreenUpdating = True
End Sub
"Buddy" wrote:
The macro seems to be getting stuck on this part of the macro
firstAddr = c.Address
"joel" wrote:
Try this
Sub ColumnMatch()
Application.ScreenUpdating = False
NewRow = 1
Set ws1 = Sheets("R1")
With ws1
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
A_Data = .Range("A" & RowCount)
B_Data = .Range("B" & RowCount)
FirstNewRow = NewRow
Set c1 = .Columns("C").Find(what:=A_Data, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c1 Is Nothing Then
firstAddr = c.Address
Do
C_Data = .Range("C" & RowCount)
D_Data = .Range("D" & RowCount)
With Sheets("Final")
.Range("A" & NewRow) = A_Data
.Range("B" & NewRow) = B_Data
.Range("C" & NewRow) = C_Data
.Range("D" & NewRow) = D_Data
NewRow = NewRow + 1
End With
Set c = .Columns("C").FindNext(after:=c)
Loop While Not c Is Nothing And c.Address < firstAddr
End If
Set c1 = .Columns("E").Find(what:=A_Data, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c1 Is Nothing Then
firstAddr = c.Address
Do
E_Data = .Range("E" & RowCount)
F_Data = .Range("F" & RowCount)
G_Data = .Range("G" & RowCount)
With Sheets("Final")
If FirstNewRow RowCount Then
.Range("A" & FirstNewRow) = A_Data
.Range("B" & FirstNewRow) = B_Data
End If
.Range("E" & FirstNewRow) = E_Data
.Range("F" & FirstNewRow) = F_Data
.Range("G" & FirstNewRow) = G_Data
FirstNewRow = FirstNewRow + 1
End With
Set c = .Columns("E").FindNext(after:=c)
Loop While Not c Is Nothing And c.Address < firstAddr
End If
Next RowCount
End With
Application.ScreenUpdating = True
End Sub
"Buddy" wrote:
Sub ColumnMatch()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim FoundOne As Range, LookInR As Range, LookForR As Range, c As Range
Dim nr3 As Long
Application.ScreenUpdating = False
Set ws1 = Sheets("R1")
Set ws2 = Sheets("R1")
Set ws3 = Sheets("R1")
Set LookInR = ws1.Range("A1").CurrentRegion
Set LookForR = Range(ws2.Range("A2"), ws2.Range("A" &
Rows.Count).End(xlUp))
nr3 = ws3.Range("A" & Rows.Count).End(xlUp).Row + 1
For Each c In LookForR
With LookInR
Set FoundOne = .Find(What:=c, LookAt:=xlPart)
Do While Not FoundOne Is Nothing
FoundOne.EntireRow.Cut Destination:=ws3.Cells(nr3, 1)
nr3 = nr3 + 1
Set FoundOne = .FindNext
Loop
End With
Next c
Set ws1 = Nothing
Set ws2 = Nothing
Set ws3 = Nothing
Set LookInR = Nothing: Set LookForR = Nothing
Application.ScreenUpdating = True
End Sub
I am trying to adapt this code to perform the following functions but its
not going that well, any feedback so that I could get it to perform the steps
below would be helpful.
1. Go to Sheet R1 look at the contents in cell A1 then look for a
duplicate of those contents in Column C and Column E.
2. When Column A has duplicates in Column C and Column E, copy that row of
Column A and include Column B, then copy the matching row in Column C while
including Column D, and finally copy the matching row of column Column E
while including the same row of Column F and Column G. In other words A:B
belong together, C:D belong together, and E:G belong together, but I want to
group these Columns together based on the contents in Columns A, C, and E.
3. Create a new worksheet and name it Final
4. Select worksheet Final and paste Columns A:B, Columns C:D, and Columns
E:G from sheet R1, which may have all been in all different rows, into the
same row in sheet Final.
Go back to sheet R1and repeat the same process for every row in Column A.
While including these two conditions
1. If Column A in sheet R1 does not have a match in Column C and Column E
then leave it alone.
2. If Column A sheet R1 has more than one match in Column C and Column E,
copy only the rows in Columns C:D, and Columns E:G where the duplicates
exist. Select sheet Final and underneath the 1st time the matching
contents were pasted in C:D and E:G paste the duplicates. After all the
duplicates have been pasted protect the same rows in Columns A:B so that no
more data can be pasted into them.
|