Complex Copy

[ryguy7272]

Complex Copy

I need to do somewhat of a complex comparison between values in two columns.
Basically, the macro below will create a new sheet and copy/paste two sets
of data from two sheets into the new sheet that was just created.

Sub ComplexCopy()

'Delete the sheet "Summary-Sheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("Analysis-Sheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "Summary-Sheet"
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = "Analysis-Sheet"

'Sheets(1).Move After:=Sheets(Sheets.Count)
Sheets("Analysis-Sheet").Move After:=Sheets(Sheets.Count)
Sheets("Analysis of Interest Prior").Select
Range("A11").Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Offset(0, 0).Resize(, 5).Copy

'ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Analysis-Sheet").Select
Range("A11").Select
ActiveSheet.Paste


Sheets("Analysis of Interest Current").Select
Range("A11").Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Offset(0, 0).Resize(, 5).Copy

'ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Analysis-Sheet").Select
Range("F11").Select
ActiveSheet.Paste

End Sub

That part works fine. The part that is tripping me up is the part when I
have to compare values in Column A (AccountNumber) and values in Column F
(AccountNumber; often the same, but sometimes different). If the two Account
Numbers are the same, I want copy the value in Column J of the same row into
Column F. If the two values are different, copy from Column F to Column J,
of the same row, to the bottom of the list, and I’ll eventually create a
little snippet of code to do a sort right at the end of the Sub. I tried to
get my results with a Pivot Table; didn’t really seem to work due to an
inability to compare the Account Numbers. Any ideas on how to do this?

Thanks,
Ryan---

 

[Jacob Skaria]

Hi Ryan

If you mean to compare row by row then try the below macro which will work
on the activesheet; starting from row 11 until it finds a blank cell in ColA

Sub Macro()
Dim lngRow As Long
lngRow = 11
Do While Range("A" & lngRow) <> ""
If Range("A" & lngRow) = Range("F" & lngRow) Then
Range("F" & lngRow) = Range("J" & lngRow)
Else
Range("J" & lngRow) = Range("F" & lngRow)
End If
lngRow = lngRow + 1
Loop
End Sub

If this post helps click Yes

 

[ryguy7272]

Wow! This is great Jacob. Just one small thing now. Somehow I need to get
the macro to check ALL values in Column A with ALL values in Column F; not
all values line up on all rows, so it's kind of tricky, at least I think so.

Then, I need to check all value in column F, and if there is a hyphen, I
know this is an account number, and so I'd like to take it and select Column
F to Column J, and cut paste to the first empty row in Column A. That's
probably much easier. I may have some code in my library that does
essentially the same thing.

I'd be thrilled if I can get some help with the first part described above
and I'd be ecstatic if I could get help with both parts described above.

Thanks so much!
Ryan---

 

[Jacob Skaria]

Ryan

This can be done..but does that make sense.. If ColA value exits in Col F then
Replace Column F value with Colum J......If you replace then is that going
to affect the next search..

Am I missing something. You can send me the file with sample data.

If this post helps click Yes

 

[ryguy7272]

Just sent you an email Jacob...

 

[Jacob Skaria]

Hi Ryan

Try the below macro which will create a copy of ws1 and work on it....Try
and feedback...

Sub CompareSheets()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lngRow As Long, lngFRow As Long

Set ws1 = Worksheets("Analysis of Interest Prior")
Set ws2 = Worksheets("Analysis of Interest Current")

ws1.Copy After:=ws2
Set ws1 = ActiveSheet

ws1.Columns("F:K").Delete
ws2.Range("E1:E9").Copy ws1.Range("F1:F9")

For lngRow = 11 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
If Trim(Range("A" & lngRow)) <> "" Then
If WorksheetFunction.CountIf(ws2.Range("A:A"), _
ws1.Range("A" & lngRow)) > 0 Then
lngFRow = WorksheetFunction.Match(ws1.Range("A" & lngRow), _
ws2.Range("A:A"), 0)
ws1.Range("F" & lngRow) = ws2.Range("E" & lngFRow)
Else
ws1.Range("F" & lngRow) = "Not found"
End If
End If
Next
End Sub

If this post helps click Yes

 

[ryguy7272]

THAT'S EXACTLY IT!!

Thanks so much!
Ryan---