Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Conditional copy and row insert based on criteria
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 3
Default Conditional copy and row insert based on criteria
Hi Everybody, I was hoping that anybody in this forum could help me
solve my particular vba problem in Excel. I need to add information
from one sheet to the other based on a certain criteria. This is how
my
information looks like:

Sheet "Source"
Code|Description|Explanation|RollupGroup
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
....
Sheet "Target"
RollupGroup|Description|ISourcetems|Cost
10|Fabric|Fabric Selections|3|12.12
20|Stitching|Stitching Instruction|2|2.33
30|Yarn Selection|2|0.56
....

I need to copy the detail information (entire row) from the source
sheet to the target sheet based on the RollupGroup information.
My new target sheet should then look like this:


Sheet "Target" (After Change)
10|Fabric|Fabric Selections|3|12.12
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
20|Stitching|Stitching Instruction|2|2.33
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
30|Yarn Selection|2|0.56
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
....

Anyones help is greatly appreciated!

Regards, Weitwinkel
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 703
Default Conditional copy and row insert based on criteria
This should do it:

Sub ConditionalCopy()
Dim Source As Worksheet
Dim Dest As Worksheet
Dim sourceRng As Range
Dim CopyRng As Range
Dim DestCell As Range
Dim CritArr

Set Source = Worksheets("Sheet1")
Set Dest = Worksheets("Sheet2")
CritArr = Dest.Range("A2", Dest.Range("A2").End(xlDown)).Value
Set sourceRng = Source.Range("A1", Source.Range("D1").End(xlDown))
Set CopyRng = sourceRng.Offset(1).Resize(sourceRng.Rows.Count - 1, 4)
Set DestCell = Dest.Range("A1").End(xlDown).Offset(1)
For ca = UBound(CritArr) To LBound(CritArr) Step -1
sourceRng.AutoFilter Field:=4, Criteria1:=CritArr(ca, 1)
Debug.Print DestCell.Address

DestCell.Resize(CopyRng.SpecialCells(xlCellTypeVis ible).Rows.Count,
1).EntireRow.Insert
Set DestCell = DestCell.End(xlUp).Offset(1)
CopyRng.SpecialCells(xlCellTypeVisible).Copy DestCell
Set DestCell = DestCell.Offset(-1)
Next
sourceRng.AutoFilter
End Sub

Regarsd,
Per

On 12 Dec., 19:05, "
wrote:
Hi Everybody, I was hoping that anybody in this forum could help me
solve my particular vba problem in Excel. I need to add information
from one sheet to the other based on a certain criteria. This is how
my
information looks like:

Sheet "Source"
Code|Description|Explanation|RollupGroup
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
...
Sheet "Target"
RollupGroup|Description|ISourcetems|Cost
10|Fabric|Fabric Selections|3|12.12
20|Stitching|Stitching Instruction|2|2.33
30|Yarn Selection|2|0.56
...

I need to copy the detail information (entire row) from the source
sheet to the target sheet based on the RollupGroup information.
My new target sheet should then look like this:

Sheet "Target" (After Change)
10|Fabric|Fabric Selections|3|12.12
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
20|Stitching|Stitching Instruction|2|2.33
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
30|Yarn Selection|2|0.56
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
...

Anyones help is greatly appreciated!

Regards, Weitwinkel

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2
Default Conditional copy and row insert based on criteria
Hi Per,

thanks for your great help. See my changes in your code. On the
ubound it is not compiling -Expected Array. What is wrong?

Sub ConditionalCopy()

Dim Source As Worksheet
Dim Dest As Worksheet
Dim sourceRng As Range
Dim CopyRng As Range
Dim DestCell As Range
Dim CritArr As Range
Dim Ca As Double


Set Source = Worksheets("Sheet1")
Set Dest = Worksheets("Sheet2")
CritArr = Dest.Range("A2", Dest.Range("A2").End(xlDown)).Value
Set sourceRng = Source.Range("A1", Source.Range("D1").End(xlDown))
Set CopyRng = sourceRng.Offset(1).Resize(sourceRng.Rows.Count - 1, 4)
Set DestCell = Dest.Range("A1").End(xlDown).Offset(1)
For Ca = UBound(CritArr) To LBound(CritArr) Step -1
sourceRng.AutoFilter Field:=4, Criteria1:=CritArr(Ca, 1)
Debug.Print DestCell.Address

DestCell.Resize(CopyRng.SpecialCells(xlCellTypeVis ible).Rows.Count,
1).EntireRow.Insert
Set DestCell = DestCell.End(xlUp).Offset(1)
CopyRng.SpecialCells(xlCellTypeVisible).Copy DestCell
Set DestCell = DestCell.Offset(-1)
Next
sourceRng.AutoFilter
End Sub



On Dec 12, 5:00*pm, Per Jessen wrote:
This should do it:

Sub ConditionalCopy()
Dim Source As Worksheet
Dim Dest As Worksheet
Dim sourceRng As Range
Dim CopyRng As Range
Dim DestCell As Range
Dim CritArr

Set Source = Worksheets("Sheet1")
Set Dest = Worksheets("Sheet2")
CritArr = Dest.Range("A2", Dest.Range("A2").End(xlDown)).Value
Set sourceRng = Source.Range("A1", Source.Range("D1").End(xlDown))
Set CopyRng = sourceRng.Offset(1).Resize(sourceRng.Rows.Count - 1, 4)
Set DestCell = Dest.Range("A1").End(xlDown).Offset(1)
For ca = UBound(CritArr) To LBound(CritArr) Step -1
* * sourceRng.AutoFilter Field:=4, Criteria1:=CritArr(ca, 1)
* * Debug.Print DestCell.Address

DestCell.Resize(CopyRng.SpecialCells(xlCellTypeVis ible).Rows.Count,
1).EntireRow.Insert
* * Set DestCell = DestCell.End(xlUp).Offset(1)
* * CopyRng.SpecialCells(xlCellTypeVisible).Copy DestCell
* * Set DestCell = DestCell.Offset(-1)
Next
sourceRng.AutoFilter
End Sub

Regarsd,
Per

On 12 Dec., 19:05, "
wrote:

Hi Everybody, I was hoping that anybody in this forum could help me
solve my particular vba problem in Excel. I need to add information
from one sheet to the other based on a certain criteria. This is how
my
information looks like:

Sheet "Source"
Code|Description|Explanation|RollupGroup
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
...
Sheet "Target"
RollupGroup|Description|ISourcetems|Cost
10|Fabric|Fabric Selections|3|12.12
20|Stitching|Stitching Instruction|2|2.33
30|Yarn Selection|2|0.56
...

I need to copy the detail information (entire row) from the source
sheet to the target sheet based on the RollupGroup information.
My new target sheet should then look like this:

Sheet "Target" (After Change)
10|Fabric|Fabric Selections|3|12.12
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
20|Stitching|Stitching Instruction|2|2.33
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
30|Yarn Selection|2|0.56
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
...

Anyones help is greatly appreciated!

Regards, Weitwinkel

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 703
Default Conditional copy and row insert based on criteria
CritArr has to be declared as Variant not as Range which you did.

I declared CritArr implicit as Variant, as a declared variable without
an explicit data type is declared as Variant.

Also, I would declare Ca as Long, because it is an Integer variable.

Per

On 13 Dec., 01:58, WeitWinkel wrote:
Hi Per,

*thanks for your great help. See my changes in your code. On the
ubound it is not compiling -Expected Array. What is wrong?

Sub ConditionalCopy()

Dim Source As Worksheet
Dim Dest As Worksheet
Dim sourceRng As Range
Dim CopyRng As Range
Dim DestCell As Range
Dim CritArr As Range
Dim Ca As Double

Set Source = Worksheets("Sheet1")
Set Dest = Worksheets("Sheet2")
CritArr = Dest.Range("A2", Dest.Range("A2").End(xlDown)).Value
Set sourceRng = Source.Range("A1", Source.Range("D1").End(xlDown))
Set CopyRng = sourceRng.Offset(1).Resize(sourceRng.Rows.Count - 1, 4)
Set DestCell = Dest.Range("A1").End(xlDown).Offset(1)
For Ca = UBound(CritArr) To LBound(CritArr) Step -1
* * sourceRng.AutoFilter Field:=4, Criteria1:=CritArr(Ca, 1)
* * Debug.Print DestCell.Address

DestCell.Resize(CopyRng.SpecialCells(xlCellTypeVis ible).Rows.Count,
1).EntireRow.Insert
* * Set DestCell = DestCell.End(xlUp).Offset(1)
* * CopyRng.SpecialCells(xlCellTypeVisible).Copy DestCell
* * Set DestCell = DestCell.Offset(-1)
Next
sourceRng.AutoFilter
End Sub

On Dec 12, 5:00*pm, Per Jessen wrote:



This should do it:

Sub ConditionalCopy()
Dim Source As Worksheet
Dim Dest As Worksheet
Dim sourceRng As Range
Dim CopyRng As Range
Dim DestCell As Range
Dim CritArr

Set Source = Worksheets("Sheet1")
Set Dest = Worksheets("Sheet2")
CritArr = Dest.Range("A2", Dest.Range("A2").End(xlDown)).Value
Set sourceRng = Source.Range("A1", Source.Range("D1").End(xlDown))
Set CopyRng = sourceRng.Offset(1).Resize(sourceRng.Rows.Count - 1, 4)
Set DestCell = Dest.Range("A1").End(xlDown).Offset(1)
For ca = UBound(CritArr) To LBound(CritArr) Step -1
* * sourceRng.AutoFilter Field:=4, Criteria1:=CritArr(ca, 1)
* * Debug.Print DestCell.Address

DestCell.Resize(CopyRng.SpecialCells(xlCellTypeVis ible).Rows.Count,
1).EntireRow.Insert
* * Set DestCell = DestCell.End(xlUp).Offset(1)
* * CopyRng.SpecialCells(xlCellTypeVisible).Copy DestCell
* * Set DestCell = DestCell.Offset(-1)
Next
sourceRng.AutoFilter
End Sub

Regarsd,
Per

On 12 Dec., 19:05, "
wrote:

Hi Everybody, I was hoping that anybody in this forum could help me
solve my particular vba problem in Excel. I need to add information
from one sheet to the other based on a certain criteria. This is how
my
information looks like:

Sheet "Source"
Code|Description|Explanation|RollupGroup
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
...
Sheet "Target"
RollupGroup|Description|ISourcetems|Cost
10|Fabric|Fabric Selections|3|12.12
20|Stitching|Stitching Instruction|2|2.33
30|Yarn Selection|2|0.56
...

I need to copy the detail information (entire row) from the source
sheet to the target sheet based on the RollupGroup information.
My new target sheet should then look like this:

Sheet "Target" (After Change)
10|Fabric|Fabric Selections|3|12.12
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
20|Stitching|Stitching Instruction|2|2.33
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
30|Yarn Selection|2|0.56
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
...

Anyones help is greatly appreciated!

Regards, Weitwinkel- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2
Default Conditional copy and row insert based on criteria
On Dec 12, 9:03*pm, Per Jessen wrote:
CritArr has to be declared as Variant not as Range which you did.

I declared CritArr implicit as Variant, as a declared variable without
an explicit data type is declared as Variant.

Also, I would declare Ca as Long, because it is an Integer variable.

Per

On 13 Dec., 01:58, WeitWinkel wrote:

Hi Per,

*thanks for your great help. See my changes in your code. On the
ubound it is not compiling -Expected Array. What is wrong?

Sub ConditionalCopy()

Dim Source As Worksheet
Dim Dest As Worksheet
Dim sourceRng As Range
Dim CopyRng As Range
Dim DestCell As Range
Dim CritArr As Range
Dim Ca As Double

Set Source = Worksheets("Sheet1")
Set Dest = Worksheets("Sheet2")
CritArr = Dest.Range("A2", Dest.Range("A2").End(xlDown)).Value
Set sourceRng = Source.Range("A1", Source.Range("D1").End(xlDown))
Set CopyRng = sourceRng.Offset(1).Resize(sourceRng.Rows.Count - 1, 4)
Set DestCell = Dest.Range("A1").End(xlDown).Offset(1)
For Ca = UBound(CritArr) To LBound(CritArr) Step -1
* * sourceRng.AutoFilter Field:=4, Criteria1:=CritArr(Ca, 1)
* * Debug.Print DestCell.Address

DestCell.Resize(CopyRng.SpecialCells(xlCellTypeVis ible).Rows.Count,
1).EntireRow.Insert
* * Set DestCell = DestCell.End(xlUp).Offset(1)
* * CopyRng.SpecialCells(xlCellTypeVisible).Copy DestCell
* * Set DestCell = DestCell.Offset(-1)
Next
sourceRng.AutoFilter
End Sub

On Dec 12, 5:00*pm, Per Jessen wrote:

This should do it:

Sub ConditionalCopy()
Dim Source As Worksheet
Dim Dest As Worksheet
Dim sourceRng As Range
Dim CopyRng As Range
Dim DestCell As Range
Dim CritArr

Set Source = Worksheets("Sheet1")
Set Dest = Worksheets("Sheet2")
CritArr = Dest.Range("A2", Dest.Range("A2").End(xlDown)).Value
Set sourceRng = Source.Range("A1", Source.Range("D1").End(xlDown))
Set CopyRng = sourceRng.Offset(1).Resize(sourceRng.Rows.Count - 1, 4)
Set DestCell = Dest.Range("A1").End(xlDown).Offset(1)
For ca = UBound(CritArr) To LBound(CritArr) Step -1
* * sourceRng.AutoFilter Field:=4, Criteria1:=CritArr(ca, 1)
* * Debug.Print DestCell.Address

DestCell.Resize(CopyRng.SpecialCells(xlCellTypeVis ible).Rows.Count,
1).EntireRow.Insert
* * Set DestCell = DestCell.End(xlUp).Offset(1)
* * CopyRng.SpecialCells(xlCellTypeVisible).Copy DestCell
* * Set DestCell = DestCell.Offset(-1)
Next
sourceRng.AutoFilter
End Sub

Regarsd,
Per

On 12 Dec., 19:05, "
wrote:

Hi Everybody, I was hoping that anybody in this forum could help me
solve my particular vba problem in Excel. I need to add information
from one sheet to the other based on a certain criteria. This is how
my
information looks like:

Sheet "Source"
Code|Description|Explanation|RollupGroup
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
...
Sheet "Target"
RollupGroup|Description|ISourcetems|Cost
10|Fabric|Fabric Selections|3|12.12
20|Stitching|Stitching Instruction|2|2.33
30|Yarn Selection|2|0.56
...

I need to copy the detail information (entire row) from the source
sheet to the target sheet based on the RollupGroup information.
My new target sheet should then look like this:

Sheet "Target" (After Change)
10|Fabric|Fabric Selections|3|12.12
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
20|Stitching|Stitching Instruction|2|2.33
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
30|Yarn Selection|2|0.56
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
...

Anyones help is greatly appreciated!

Regards, Weitwinkel- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -

GENIUS! You just made my day!
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

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
Macro Help - Insert row/copy based on criteria Katerinia Excel Programming 3 April 7th 10 12:08 AM
Insert number of rows based on criteria S Davis Excel Programming 5 January 9th 09 09:00 AM
insert rows based on criteria MP Excel Discussion (Misc queries) 3 December 4th 08 02:19 PM
insert rows based on criteria MP Excel Discussion (Misc queries) 0 December 3rd 08 06:36 PM
Insert text from another workbook based on criteria Tacrier Excel Worksheet Functions 4 April 9th 08 11:01 PM


All times are GMT +1. The time now is 06:15 AM.

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

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement