Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Old August 20th 20, 05:01 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2020
Posts: 9
Default Select identical column/rows based on the active cell and copy datato another sheet

Hello ,

If somebody can help me out.

In a sheet the macro need to select all identical cells in column D that has the same text in it as cell D of the active row of the active cell and then copy the selected data to another sheet. After that it has to copy/paste several other columns but for the same rows selected.

For example...
The active cell is column K row 20. In this row in column D is 'AAA' registered. The macro had to to select in column D the cells above and below all the cells were also 'AAA' is registered (remarks; The cells are sorted so the ones with 'AAA' are always near each other, there is never another data registered in between of it).

Then this selected cells has to be copied to Sheet2 Cell A2.
The macro knows the range of selected rows. It should copy for the same rows the data from another column;
Column F to Sheet2 Cell B2
Column G to Sheet2 Cell C2
Column U to sheet2 Cell D2

Should be nice if I can get some help on it.

regards, Johan.


  #2   Report Post  
Old August 20th 20, 05:33 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2011
Posts: 3,802
Default Select identical column/rows based on the active cell and copy data to another sheet

Hi Johan,

Am Thu, 20 Aug 2020 09:01:53 -0700 (PDT) schrieb :

In a sheet the macro need to select all identical cells in column D that has the same text in it as cell D of the active row of the active cell and then copy the selected data to another sheet. After that it has to copy/paste several other columns but for the same rows selected.

For example...
The active cell is column K row 20. In this row in column D is 'AAA' registered. The macro had to to select in column D the cells above and below all the cells were also 'AAA' is registered (remarks; The cells are sorted so the ones with 'AAA' are always near each other, there is never another data registered in between of it).

Then this selected cells has to be copied to Sheet2 Cell A2.
The macro knows the range of selected rows. It should copy for the same rows the data from another column;
Column F to Sheet2 Cell B2
Column G to Sheet2 Cell C2
Column U to sheet2 Cell D2


try:

Sub FindAndCopy()
Dim rngBig As Range, c As Range
Dim FirstAddress As String

With Sheets("Sheet1")
Set c = .Columns("D").Find(what:=.Range("D" & ActiveCell.Row), _
lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If rngBig Is Nothing Then
Set rngBig = Union(c, .Range("F" & c.Row & ":G" & c.Row), _
.Range("U" & c.Row))
Else
Set rngBig = Union(rngBig, c, _
.Range("F" & c.Row & ":G" & c.Row), .Range("U" & c.Row))
End If
Set c = .Columns("D").FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If
End With
rngBig.Copy Sheets("Sheet2").Range("A2")
End Sub


Regards
Claus B.
--
Windows10
Office 2016
  #3   Report Post  
Old August 20th 20, 07:09 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2020
Posts: 9
Default Select identical column/rows based on the active cell and copydata to another sheet

Dear Claus,

Thanks a lot (again!).
Works perfect and clear to understand.

regards, Johan
  #4   Report Post  
Old August 22nd 20, 09:03 AM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2020
Posts: 9
Default Select identical column/rows based on the active cell and copydata to another sheet

I thought....... easy to change so it can fullfill my wished result
So I extended the code with the other columns that I need to copy, but....... in another different way.

------ changed code -------------------
Sub FindAndCopy()
Dim rngBig As Range, c As Range
Dim FirstAddress As String

With Sheets("Sheet1")
Set c = .Columns("D").Find(what:=.Range("D" & ActiveCell.Row), _
lookat:=xlWhole)

If Not c Is Nothing Then
FirstAddress = c.Address
Do

If rngBig Is Nothing Then
Set rngBig = Union(c, .Range("F" & c.Row & ":G" & c.Row), .Range("H" & c.Row), _
.Range("M" & c.Row), .Range("S" & c.Row), .Range("U" & c.Row), .Range("X" & c.Row), _
.Range("AA" & c.Row), .Range("AD" & c.Row), .Range("AG" & c.Row), .Range("AJ" & c.Row), .Range("AM" & c.Row), _
.Range("AB" & c.Row), .Range("AE" & c.Row), .Range("AH" & c.Row), .Range("AK" & c.Row), .Range("AN" & c.Row), _
.Range("AC" & c.Row), .Range("AF" & c.Row), .Range("AI" & c.Row), .Range("AL" & c.Row), .Range("AO" & c.Row))
Else
Set rngBig = Union(rngBig, c, .Range("F" & c.Row & ":G" & c.Row), .Range("H" & c.Row), _
.Range("M" & c.Row), .Range("S" & c.Row), .Range("U" & c.Row), .Range("X" & c.Row), _
.Range("AA" & c.Row), .Range("AD" & c.Row), .Range("AG" & c.Row), .Range("AJ" & c.Row), .Range("AM" & c.Row), _
.Range("AB" & c.Row), .Range("AE" & c.Row), .Range("AH" & c.Row), .Range("AK" & c.Row), .Range("AN" & c.Row), _
.Range("AC" & c.Row), .Range("AF" & c.Row), .Range("AI" & c.Row), .Range("AL" & c.Row), .Range("AO" & c.Row))
End If

Set c = .Columns("D").FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If
End With

rngBig.Copy Sheets("Sheet2").Range("A2")
End Sub
-------------------------
For the selected rows (with all the same text in column D) the copy result to Sheet2 should be in the order as changed now in the code resulting in;

Sheet1 - Sheet2
D - A
F - B
G - C
H - D
M - E
S - F
U - G
X - H
AA - I
AD - J
AG - K
AJ - L
AM - M
AB - N
AE - O
AH - P
AK - Q
AN - R
AC - S
AF - T
AI - U
AL - V
AO - W

But.............
The code copied to Sheet2 A till H in the correct column (oke).
but in column I till W the data is I=AA, J=AB, K=AC till W=AO instead of I=AA, J=AD, K=AG etc..
It looks like the code can, wrote on this way, only handle with columns in the normal order.

Question..... what is the solution. Can somebody explain me what to change in the code

regards, Johan


  #5   Report Post  
Old August 24th 20, 07:38 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2011
Posts: 3,802
Default Select identical column/rows based on the active cell and copy data to another sheet

Hi Johan,

Am Sat, 22 Aug 2020 01:03:04 -0700 (PDT) schrieb :

I thought....... easy to change so it can fullfill my wished result
So I extended the code with the other columns that I need to copy, but....... in another different way.


But.............
The code copied to Sheet2 A till H in the correct column (oke).
but in column I till W the data is I=AA, J=AB, K=AC till W=AO instead of I=AA, J=AD, K=AG etc..
It looks like the code can, wrote on this way, only handle with columns in the normal order.


for me it works fine.
But here is another suggestion:

Sub FindAndCopy()
Dim rngBig As Range, c As Range
Dim FirstAddress As String
Dim varRows() As Variant, varCols As Variant
Dim strCols As String
Dim n As Integer, i As Integer

strCols = "D, F, G, H, M, S, U, X, AA, AD, AG, AJ, AM, AB, AE, AH, AK,
AN, AC, AF, AI, AL, AO"
varCols = Split(strCols, ", ")

With Sheets("Sheet1")
Set c = .Columns("D").Find(what:=.Range("D" & ActiveCell.Row), _
lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
ReDim Preserve varRows(n)
varRows(n) = c.Row
n = n + 1
Set c = .Columns("D").FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If

For i = LBound(varCols) To UBound(varCols)
For n = LBound(varRows) To UBound(varRows)
If rngBig Is Nothing Then
Set rngBig = .Range(varCols(i) & varRows(n))
Else
Set rngBig = Union(rngBig, .Range(varCols(i) & varRows(n)))
End If
Next n
rngBig.Copy Sheets("Sheet2").Cells(2, i + 1)
Set rngBig = Nothing
Next i
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016


  #6   Report Post  
Old August 28th 20, 10:04 AM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2020
Posts: 9
Default Select identical column/rows based on the active cell and copydata to another sheet

Dear Claus,

You're the best !!
Thanks a lot

regards, Johan


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Hide rows without data in a column based on active cell [email protected] Excel Programming 9 March 11th 16 08:00 PM
Copy rows to new sheet based on value in column A Fredy617 Excel Discussion (Misc queries) 0 February 11th 13 06:29 PM
Help tonight?!! select rows based on cell value in a column Lighthouse1 Excel Worksheet Functions 1 January 31st 07 03:57 AM
MACRO - copy rows based on value in column to another sheet Michael A Excel Discussion (Misc queries) 1 March 5th 05 03:15 AM
MACRO - copy rows based on value in column to another sheet Mike Excel Programming 2 March 5th 05 01:21 AM


All times are GMT +1. The time now is 03:13 PM.

Powered by vBulletin® Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright 2004-2020 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Copyright © 2017