Copying certain cells of data in a row - Barry Davidson

Posted by John S on October 10, 2001 2:33 PM

Here's a question to any who might be interested:

I have code that selectively finds important rows in my data.
When I get to an important row I copy only one cell, the cell
which determines if the row is important. I need to copy other
info in that row. How can i do this? Here is a simplified version
of what I'm talking about:

The "Class" column is what I use to select a row and this is done when the class
changes(ie from class1 to class2).

So when Class1 changes to class2 I want to copy Class2 in column C
Length in Column E and time in column I. These are to be pasted in
another workbook in three cells(ie K,L,M). Here is code I have, provided
by Barrie Davidson, except it only copies the class data column(C)

Sub ABTID_Copy()
Dim valuetocompare
Dim currentfile As String

currentfile = ActiveWorkbook.Name
Range("C2").Select
Do Until Selection.Value = ""
If Selection.Value &LT;&GT; valuetocompare Then
valuetocompare = Selection.Value
Selection.Copy
Windows("Summary").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Activate

End If
Windows(currentfile).Activate
ActiveCell.Offset(1, 0).Activate
Loop
End Sub

Thanks In advance to anyone who can spend some time on this. I'd appreciate it.
Sincerely,
John

Posted by Anon on October 10, 2001 3:59 PM

Dim wb1 As Workbook, wb2 As Workbook
Dim sSheet As Worksheet, dSheet As Worksheet
Dim sRng As Range, dRng As Range

Set wb1 = Workbooks("whatever1.xls")
Set wb2 = Workbooks("whatever2.xls")
Set sSheet = wb1.Sheets("Sheet1")
Set dSheet = wb2.Sheets("Sheet1")
With sSheet
Set sRng = .Range(.Range("C2"), .Range("C65536").End(xlUp)).Resize(, 7)
Set dRng = dSheet.Range("K65536").End(xlUp).Offset(1, 0)

Application.ScreenUpdating = False
.Range("D:D,F:H").EntireColumn.Hidden = True
sRng.Resize(, 1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
sRng.SpecialCells(xlCellTypeVisible).Copy dRng
.ShowAllData
.Range("B:B,F:H").EntireColumn.Hidden = False
End With
Application.ScreenUpdating = True

Posted by Anon on October 10, 2001 4:01 PM

Note .....

I have assumed that you have headers in row 1 and that your data starts in row 2.

Posted by John S on October 11, 2001 8:41 AM

Great, but how to repeat the code block???

Thanks this worked great except for one thing. I need the code to repeat over and over until EOF.
The sample data I gave above, is one "paragraph" of data in this source workbook. In reality there
is a blank row after that sample stuff and then another paragraph to search through. What I need is for
the code to operate as it does on a paragraph of data, and when it senses a blank row reset and perform
code again for the next group until it finds no more paragraphs. I hope this isn't too confusing.

Again, thank you all so much for your time. I really appreciate it!
Sincerely,
John

Posted by Anon on October 11, 2001 4:56 PM

Re: Great, but how to repeat the code block???

Are you sure you've now described all of the conditions?
Try this :-

Dim wb1 As Workbook, wb2 As Workbook
Dim sSheet As Worksheet, dSheet As Worksheet
Dim sRng As Range, dRng As Range
Dim rw As Long
Set wb1 = Workbooks("whatever1.xls")
Set wb2 = Workbooks("whatever2.xls")
Set sSheet = wb1.Sheets("Sheet1")
Set dSheet = wb2.Sheets("Sheet1")
Application.ScreenUpdating = False
With sSheet
.Range("D:D,F:H").EntireColumn.Hidden = True
Set sRng = .Range(.Range("C1"), .Range("C1").End(xlDown)).Resize(, 7)
Do
Set dRng = dSheet.Range("K65536").End(xlUp).Offset(2, 0)
sRng.Resize(, 1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
sRng.SpecialCells(xlCellTypeVisible).Copy dRng
rw = sRng(1, 1).row + sRng.Rows.Count + 1
Set sRng = .Range(.Cells(rw, 3), .Cells(rw, 3).End(xlDown)).Resize(, 7)
Loop While sRng(1, 1).Value &LT;&GT; ""
.Range("B:B,F:H").EntireColumn.Hidden = False
.ShowAllData
End With
Application.ScreenUpdating = True