Loop returns only one value, does not loop & an assignment to columnhow-to problem.

  • Thread starter Thread starter Howard
  • Start date Start date
H

Howard

Three sheets with code in sheet 1
Sheet 2 & 3 are identical data layout.
Want to loop through column K of sheet 2 & 3. (later there will be
sheets 2, 3, 4, 5 to loop through. Just 2 in this test example)

I have two problems.
The code does not error out BUT only returns the first value of sheet 2 to
sheet 1. The Loop does not loop. Every value in column K2 on down of the two loop sheets is greater than 1 in this test. (on finished project not all K values will be greater than 1)

The second problem are these lines.
The first line will grab a value from column C which will be one of eleven different Products. Product A through K. If it is "Product A" then it must go to
column D on sheet 1. If it is "Product G" then it must go to column L on sheet 1.

'Set prdCopy = wrkSheet.Range("C" & c.Row)
'prdPasteRow = Sheets(strConsTab).Cells(Rows.Count, "??").End(xlUp).Row + 1
'prdCopy.Copy Sheets(strConsTab).Range("??" & prdPasteRow)

The key for product-from loop to-column on sheet 1 is:

A to D, B to E, C to G, D to H, E to I, F to K,
G to L, H to M, I to O, j to P, K to Q.

Note that sheet 1 columns F, J & N are not used in this transfer key.
I have no clue how to make this work.

Thanks.
Howard

Option Explicit

Sub SheetTwoToFiveToOne()

Dim wrkSheet As Worksheet
Dim namCopy As Range
Dim prdCopy As Range

Dim zipCopy As Range
Dim namPasteRow As Long
Dim prdPasteRow2 As Long
Dim zipPasteRow As Long
Dim strConsTab As String
Dim c As Range

strConsTab = ActiveSheet.Name

Application.ScreenUpdating = False

For Each wrkSheet In ActiveWorkbook.Worksheets
If wrkSheet.Name <> strConsTab Then
For Each c In Range("K2:K" & Range("K" & Rows.Count).End(xlUp).Row)
If c.Value <> 1 Then

Set namCopy = wrkSheet.Range("A" & c.Row)
'Set prdCopy = wrkSheet.Range("C" & c.Row)
Set zipCopy = wrkSheet.Range("E" & c.Row)

namPasteRow = Sheets(strConsTab).Cells(Rows.Count, "A") _
.End(xlUp).Row + 1
'prdPasteRow = Sheets(strConsTab).Cells(Rows.Count, "??") _
.End(xlUp).Row + 1
zipPasteRow = Sheets(strConsTab).Cells(Rows.Count, "S") _
.End(xlUp).Row + 1

namCopy.Copy Sheets(strConsTab).Range("A" & namPasteRow)
'prdCopy.Copy Sheets(strConsTab).Range("??" & prdPasteRow)
zipCopy.Copy Sheets(strConsTab).Range("S" & zipPasteRow)

Application.CutCopyMode = False
End If
Next
End If
Next wrkSheet

Application.ScreenUpdating = True
End Sub
 
Try...

Sub Sheet2To5To1()
Dim lNamRow&, lPrdRow&, lZipRow&, lLastRow, rng
Dim wksTarget As Worksheet, wks
Dim vEvents, vCalcMode, vDisplay

Set wksTarget = ActiveSheet
With wksTarget
lNamRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' lPrdRow = .Cells(.Rows.Count, "??").End(xlUp).Row
lZipRow = .Cells(.Rows.Count, "S").End(xlUp).Row
End With 'wksTarget

With Application
vEvents = .EnableEvents: .EnableEvents = False
vCalcMode = .Calculation: .Calculation = xlCalculationManual
vDisplay = .ScreenUpdating: .ScreenUpdating = False
End With 'Application

For Each wks In ActiveWorkbook.Worksheets
If Not wks Is wksTarget Then
lLastRow = wks.Cells(wks.Rows.Count, "K").End(xlUp).Row
For Each rng In wks.Range("K2:K" & lLastRow)
If Not rng.Value = 1 Then
lNamRow = lNamRow + 1: lZipRow = lZipRow + 1
'lPrdRow = lPrdRow + 1
With wksTarget
.Range("A" & lNamRow).Value = _
wks.Range("A" & rng.Row).Value
' .Range("??" & lPrdRow).Value = _
wks.Range("C" & rng.Row).Value
.Range("S" & lZipRow).Value = _
wks.Range("E" & rng.Row).Value
End With 'wksTarget
End If 'Not rng.Value = 1
Next 'rng
End If 'Not wks = wksTarget
Next 'wks

With Application
.EnableEvents = vEvents
.Calculation = vCalcMode
.ScreenUpdating = vDisplay
End With 'Application
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Great, the loop works fine. Thanks.

I now need to address the "Product N" copy problem.
Using the If - ElseIf statements below (these are the first two and the last two for example) I had semi success in my code copying the product to theproper column on sheet 1. Major problem was keeping the Product on the same row as the Zip and Name. The Zip and name offset themselves from the previous copy by one row from the last copy, but the Product would go to the top of the column because not every product column of the eleven have a value to offset from each and every time like the Zip and Name do.

So if the next Zip and Name are copied to say row 7, the Product might go on up four more rows until it can offset from a value in that column and therefore NOT be aligned with the proper Zip and Name it came over with.

I tried keying off of the Name copy by the number of columns to the right that the Product should be in... but that turned into a brick wall for me, could not make it happen.

I also tried to insert these If - ElseIf's into your code and that turned into a dead end, it didn't error out, it just would not copy and the loop seemed to run just fine.

I see you have Dim'ed "lPrdRow&" but making the Product column destination determination is loosing me.

Howard

Set prdCopy = wrkSheet.Range("C" & c.Row)

If prdCopy = "Product A" Then
prdPasteRow = Sheets(strConsTab).Cells(Rows.Count, "D") _
.End(xlUp).Row + 1
prdCopy.Copy Sheets(strConsTab).Range("D" & prdPasteRow)

ElseIf prdCopy = "Product B" Then
prdPasteRow = Sheets(strConsTab).Cells(Rows.Count, "E") _
.End(xlUp).Row + 1
prdCopy.Copy Sheets(strConsTab).Range("E" & prdPasteRow)

' With 7 more ElseIf statements here to
' cover all the copy to columns on sheet 1.

ElseIf prdCopy = "Product J" Then
prdPasteRow = Sheets(strConsTab).Cells(Rows.Count, "P") _
.End(xlUp).Row + 1
prdCopy.Copy Sheets(strConsTab).Range("P" & prdPasteRow)

ElseIf prdCopy = "Product K" Then
prdPasteRow = Sheets(strConsTab).Cells(Rows.Count, "Q") _
.End(xlUp).Row + 1
prdCopy.Copy Sheets(strConsTab).Range("Q" & prdPasteRow)

Else
End If
 
Howard,
I suspected this might be an issue since your code set the next row for
each column, resulting in the possibility of data row misalignment. I
don't get why you don't just insert on the next available row on
wksTarget, using 1 column for setting the position so all data gets
distributed along the same row (thus aligned).

So instead of...

Dim lNamRow&, lPrdRow&, lZipRow&

...simply...

Dim lNextRow&

...and set it to the last row of data same as the others were done
individually...

Sub Sheet2To5To1()
Dim lNextRow&, lLastRow, rng
Dim wksTarget As Worksheet, wks
Dim vEvents, vCalcMode, vDisplay

Set wksTarget = ActiveSheet
With wksTarget
' lNamRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' lPrdRow = .Cells(.Rows.Count, "??").End(xlUp).Row
' lZipRow = .Cells(.Rows.Count, "S").End(xlUp).Row
'Get the current last row of data
lNextRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With 'wksTarget

With Application
vEvents = .EnableEvents: .EnableEvents = False
vCalcMode = .Calculation: .Calculation = xlCalculationManual
vDisplay = .ScreenUpdating: .ScreenUpdating = False
End With 'Application

For Each wks In ActiveWorkbook.Worksheets
If Not wks Is wksTarget Then
lLastRow = wks.Cells(wks.Rows.Count, "K").End(xlUp).Row
For Each rng In wks.Range("K2:K" & lLastRow)
If Not rng.Value = 1 Then
'lNamRow = lNamRow + 1: lZipRow = lZipRow + 1
'lPrdRow = lPrdRow + 1
lNextRow = lNextRow + 1
With wksTarget
.Range("A" & lNextRow).Value = _
wks.Range("A" & rng.Row).Value
' .Range("??" & lNextRow).Value = _
wks.Range("C" & rng.Row).Value
.Range("S" & lNextRow).Value = _
wks.Range("E" & rng.Row).Value
End With 'wksTarget
End If 'Not rng.Value = 1
Next 'rng
End If 'Not wks = wksTarget
Next 'wks

With Application
.EnableEvents = vEvents
.Calculation = vCalcMode
.ScreenUpdating = vDisplay
End With 'Application
End Sub

...and just decide what column on wksTarget you want to put the value
into!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
..and just decide what column on wksTarget you want to put the value

into!
Click to expand...
Garry
Click to expand...

Do I use the If - ElseIf statements to make that column decision?

So far I have been able to put all the products in a single column on wksTarget, which is worthless or I can put all the products in the correct columns of wksTarget but on the wrong row, also worthless.

Can't figure out how to make the products follow Name and Zip to the same row.

The concept is perfectly clear to me, execution is probably less than ten code words to make it happen. Its not coming to me.

Howard
 
Do I use the If - ElseIf statements to make that column decision?

So far I have been able to put all the products in a single column on
wksTarget, which is worthless or I can put all the products in the
correct columns of wksTarget but on the wrong row, also worthless.

Can't figure out how to make the products follow Name and Zip to the
same row.

The concept is perfectly clear to me, execution is probably less than
ten code words to make it happen. Its not coming to me.

Howard
Click to expand...

The last code example I posted puts all 3 values in the same row. Just
decide which column for the product! How would this need an
If...Then construct? How did you determine where the other 2 values
("A", "S") go? Do same for the 3rd value! (IOW, replace the "??" with a
column label)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
The last code example I posted puts all 3 values in the same row. Just

decide which column for the product! How would this need an

If...Then construct? How did you determine where the other 2 values

("A", "S") go? Do same for the 3rd value! (IOW, replace the "??" with a

column label)
Click to expand...


If I take this:
..Range("??" & lNextRow).Value = _
wks.Range("C" & rng.Row).Value

and do this:

..Range("D" & lNextRow).Value = _
wks.Range("C" & rng.Row).Value

It puts all the products in wksTarget column D, and I need it to descriminate between wksTarget columns D, E, G, H, I, K, L, M, O, P, or Q with each step of the Loop K2...etc.

Howard
 
The last code example I posted puts all 3 values in the same row.
Just

decide which column for the product! How would this need an

If...Then construct? How did you determine where the other 2 values

("A", "S") go? Do same for the 3rd value! (IOW, replace the "??"
with a

column label)
Click to expand...


If I take this:
.Range("??" & lNextRow).Value = _
wks.Range("C" & rng.Row).Value

and do this:

.Range("D" & lNextRow).Value = _
wks.Range("C" & rng.Row).Value

It puts all the products in wksTarget column D, and I need it to
descriminate between wksTarget columns D, E, G, H, I, K, L, M, O, P,
or Q with each step of the Loop K2...etc.

Howard
Click to expand...


Based on what criteria?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
The last code example I posted puts all 3 values in the same row.
Just

decide which column for the product! How would this need an

If...Then construct? How did you determine where the other 2 values

("A", "S") go? Do same for the 3rd value! (IOW, replace the "??"
with a

column label)
Click to expand...


If I take this:
.Range("??" & lNextRow).Value = _
wks.Range("C" & rng.Row).Value

and do this:

.Range("D" & lNextRow).Value = _
wks.Range("C" & rng.Row).Value

It puts all the products in wksTarget column D, and I need it to
descriminate between wksTarget columns D, E, G, H, I, K, L, M, O, P,
or Q with each step of the Loop K2...etc.

Howard
Click to expand...


Based on what criteria?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
If I take this:
Based on what criteria?
Click to expand...


The key for "product-from loop" to "column on wksTarget" is:

Prd-A to D, Prd-B to E, Prd-C to G, Prd-D to H, Prd-E to I, Prd-F to K,
Prd-G to L, Prd-H to M, Prd-I to O, Prd-J to P, Prd-K to Q.

Howard
 
The key for "product-from loop" to "column on wksTarget" is:
Prd-A to D, Prd-B to E, Prd-C to G, Prd-D to H, Prd-E to I, Prd-F to
K,
Prd-G to L, Prd-H to M, Prd-I to O, Prd-J to P, Prd-K to Q.
Click to expand...

Ok, so how is the -A or -B determined? Is it how the product displays
in ColumnC on the other sheets? If so, a simple lookup table is all
that's needed. Better yet would be to use an array so you can loop
through it to grab which column to use.

Obviously you want to be able to add/remove items in the product list
and so I suggest using a dynamic named range to store this criteria so
you can update it without having to mess with the code.

I recommend using 2 hidden rows at the top of the wksTarget, where the
criteria is in row1 and the column assignment in row2...

A B C D E F G H I J K
D E G H I K L M O P Q

...or you could store this as constants in the code module...

Const sPrdID$ = "A:D,B:E,C:G,D:H,E:I,F:K,G:L,H:M,I:O,J:P,K:Q"

...so the criteria is 'aligned' as 'value pairs'. Either approach will
work the same way, looping the array to match PrdID and grab its column
assignment.

The only diff between the 2 approaches is the 1st will use a single 2D
array (vPrds); the 2nd would use a 1D array (vPrds). The indexes will
match either way so it's just a matter of deciding what will work for
you best!

<FWIW>
My pref would be to use the delimited string value pairs...


Sub Sheet2To5To1()
Dim lNextRow&, lLastRow&, n&, rng, vPrds, vP
Dim wksTarget As Worksheet, wks, vEvents, vCalcMode, vDisplay

Const sPrdID$ = "A:D,B:E,C:G,D:H,E:I,F:K,G:L,H:M,I:O,J:P,K:Q"

Set wksTarget = ActiveSheet
With wksTarget
'Get the current last row of data
lNextRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With 'wksTarget

With Application
vEvents = .EnableEvents: .EnableEvents = False
vCalcMode = .Calculation: .Calculation = xlCalculationManual
vDisplay = .ScreenUpdating: .ScreenUpdating = False
End With 'Application

vPrds = Split(sPrdID, ",")
For Each wks In ActiveWorkbook.Worksheets
If Not wks Is wksTarget Then
lLastRow = wks.Cells(wks.Rows.Count, "K").End(xlUp).Row
For Each rng In wks.Range("K2:K" & lLastRow)
If Not rng.Value = 1 Then
lNextRow = lNextRow + 1
With wksTarget
.Cells(lNextRow, "A") = wks.Cells(rng.Row, "A")
For n = LBound(vPrds) To UBound(vPrds)
vP = Split(vPrds(n), ":")
If Right(wks.Cells(rng.Row, "C"), 1) = vP(0) Then
.Cells(lNextRow, vP(1)) = wks.Cells(rng.Row, "C")
Exit For
End If
Next 'n
.Cells(lNextRow, "S") = wks.Cells(rng.Row, "E")
End With 'wksTarget
End If 'Not rng.Value = 1
Next 'rng
End If 'Not wks = wksTarget
Next 'wks

With Application
.EnableEvents = vEvents
.Calculation = vCalcMode
.ScreenUpdating = vDisplay
End With 'Application
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Ok, so how is the -A or -B determined? Is it how the product displays

in ColumnC on the other sheets? If so, a simple lookup table is all

that's needed. Better yet would be to use an array so you can loop

through it to grab which column to use.



Obviously you want to be able to add/remove items in the product list

and so I suggest using a dynamic named range to store this criteria so

you can update it without having to mess with the code.



I recommend using 2 hidden rows at the top of the wksTarget, where the

criteria is in row1 and the column assignment in row2...



A B C D E F G H I J K

D E G H I K L M O P Q



..or you could store this as constants in the code module...



Const sPrdID$ = "A:D,B:E,C:G,D:H,E:I,F:K,G:L,H:M,I:O,J:P,K:Q"



..so the criteria is 'aligned' as 'value pairs'. Either approach will

work the same way, looping the array to match PrdID and grab its column

assignment.



The only diff between the 2 approaches is the 1st will use a single 2D

array (vPrds); the 2nd would use a 1D array (vPrds). The indexes will

match either way so it's just a matter of deciding what will work for

you best!



<FWIW>

My pref would be to use the delimited string value pairs...





Sub Sheet2To5To1()

Dim lNextRow&, lLastRow&, n&, rng, vPrds, vP

Dim wksTarget As Worksheet, wks, vEvents, vCalcMode, vDisplay



Const sPrdID$ = "A:D,B:E,C:G,D:H,E:I,F:K,G:L,H:M,I:O,J:P,K:Q"



Set wksTarget = ActiveSheet

With wksTarget

'Get the current last row of data

lNextRow = .Cells(.Rows.Count, "A").End(xlUp).Row

End With 'wksTarget



With Application

vEvents = .EnableEvents: .EnableEvents = False

vCalcMode = .Calculation: .Calculation = xlCalculationManual

vDisplay = .ScreenUpdating: .ScreenUpdating = False

End With 'Application



vPrds = Split(sPrdID, ",")

For Each wks In ActiveWorkbook.Worksheets

If Not wks Is wksTarget Then

lLastRow = wks.Cells(wks.Rows.Count, "K").End(xlUp).Row

For Each rng In wks.Range("K2:K" & lLastRow)

If Not rng.Value = 1 Then

lNextRow = lNextRow + 1

With wksTarget

.Cells(lNextRow, "A") = wks.Cells(rng.Row, "A")

For n = LBound(vPrds) To UBound(vPrds)

vP = Split(vPrds(n), ":")

If Right(wks.Cells(rng.Row, "C"), 1) = vP(0) Then

.Cells(lNextRow, vP(1)) = wks.Cells(rng.Row, "C")

Exit For

End If

Next 'n

.Cells(lNextRow, "S") = wks.Cells(rng.Row, "E")

End With 'wksTarget

End If 'Not rng.Value = 1

Next 'rng

End If 'Not wks = wksTarget

Next 'wks



With Application

.EnableEvents = vEvents

.Calculation = vCalcMode

.ScreenUpdating = vDisplay

End With 'Application

End Sub



--

Garry



Free usenet access at http://www.eternal-september.org

Classic VB Users Regroup!

comp.lang.basic.visual.misc

microsoft.public.vb.general.discussion
Click to expand...
 
I'll play with what you posted.

I may have missled you with this.

Prd-A to D, Prd-B to E, Prd-C to G, Prd-D

Means:

"Product A" goes to wksTarget column D
"Product B" goes to wksTarget column E
"Product C" goes to wksTarget column G
"Product D" goes to wksTarget column H
"Product E" goes to wksTarget column H
"Product F" goes to wksTarget column K
"Product G" goes to wksTarget column L
"Product H" goes to wksTarget column M
"Product I" goes to wksTarget column O
"Product J" goes to wksTarget column P
"Product K" goes to wksTarget column Q

Howard
 
I'll play with what you posted.

Don't play! Just test drive said:
I may have missled you with this.

Prd-A to D, Prd-B to E, Prd-C to G, Prd-D

Means:

"Product A" goes to wksTarget column D
"Product B" goes to wksTarget column E
"Product C" goes to wksTarget column G
"Product D" goes to wksTarget column H
"Product E" goes to wksTarget column H
"Product F" goes to wksTarget column K
"Product G" goes to wksTarget column L
"Product H" goes to wksTarget column M
"Product I" goes to wksTarget column O
"Product J" goes to wksTarget column P
"Product K" goes to wksTarget column Q

Howard
Click to expand...

As long as the rightmost character matches it doesn't matter. Though,
you can edit the left side of the value-pairs to match exactly...

"Product A:D,Product B:E,Product C:G"

...and so on. I just took a shortcut! To do exact match will require
changing code accordingly.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
The code just posted works perfectly fine to me. I'm sure I am not the one to determine if one method works better than the other.


<FWIW>
<My pref would be to use the delimited string value pairs...>

As is suits me me to a tee!!

And Garry pulls Howards fat out of the fire yet again!

As always, Garry, I really appreciate your expertise. Must take the patience
of Job to deal with me.

Regards,
Howard
 
The code just posted works perfectly fine to me. I'm sure I am not the one to determine if one method works better than the other.





<FWIW>

<My pref would be to use the delimited string value pairs...>



As is suits me me to a tee!!



And Garry pulls Howards fat out of the fire yet again!



As always, Garry, I really appreciate your expertise. Must take the patience

of Job to deal with me.



Regards,

Howard
Click to expand...

Just to add, the one row gap between incoming sheets data is sorta a neat little item. Basically the break indicates "stuff from the next sheet".

Does raise the question of why there is no gap between the headers and first sheet data but there is between the subsequent sheet data imports. I don't intend to change anything.

Again, thanks.

Howard
 
The code just posted works perfectly fine to me. I'm sure I am not
the one to determine if one method works better than the other.


<FWIW>
<My pref would be to use the delimited string value pairs...>

As is suits me me to a tee!!

And Garry pulls Howards fat out of the fire yet again!

As always, Garry, I really appreciate your expertise. Must take the
patience of Job to deal with me.

Regards,
Howard
Click to expand...

Ha,ha,ha! Glad you're happy with it. I appreciate the feedback!

BTW, I remember when I gave Job some of my patience; I just can't
remember when as it seems it was such a long time ago!<bg>

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Just to add, the one row gap between incoming sheets data is sorta a
neat little item. Basically the break indicates "stuff from the next
sheet".

Does raise the question of why there is no gap between the headers
and first sheet data but there is between the subsequent sheet data
imports. I don't intend to change anything.
Click to expand...

The first row of data from each sheet will always skip a row as a
result of the first sheet starting 1 row below the headings. If no
headings (ergo blank sheet) row1 would be blank because the increment
is at the start of the loop rather than the end. If incrementing at the
end you'd need to 'initialize' lNextRow to start at row2 (if headings),
otherwise row1 (or wherever you prefer to start).

Personally, I like the way this works because it 'sections' each
sheet's data. Normally I prefer contiguous rows and would normally
increase RowHeight of each 1st row from the other sheets.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
The first row of data from each sheet will always skip a row as a
result of the first sheet starting 1 row below the headings. If no
headings (ergo blank sheet) row1 would be blank because the increment
is at the start of the loop rather than the end. If incrementing at
the end you'd need to 'initialize' lNextRow to start at row2 (if
headings), otherwise row1 (or wherever you prefer to start).
Click to expand...

Duh.., not sure why I babbled on about the spacing because there isn't
any space between sheets on my wksTarget.

To clarify:
Collected data starts in row2 of each sheet and is contiguous all the
way down when added to wksTarget. IOW, it skips the header row for each
sheet because it starts at K2!
Personally, I like the way this works because it 'sections' each
sheet's data. Normally I prefer contiguous rows and would normally
increase RowHeight of each 1st row from the other sheets.
Click to expand...

As I stated, that's my preferred approach. I use a 'trigger' variable
(0/1) to set RowHeight for each sheet's 1st row of data...

Dim iPos% '//add to variable defs at top of Sub

<snip>...
If Not wks Is wksTarget Then
lLastRow = wks.Cells(wks.Rows.Count, "K").End(xlUp).Row
iPos = 1 '//initialize RowHeight trigger
For Each rng In wks.Range("K2:K" & lLastRow)
If Not rng.Value = 1 Then
lNextRow = lNextRow + 1
With wksTarget
'Set RowHeight for the 1st row of each wks data.
'then reset the trigger to skip subsequent rows.
If iPos > 0 Then .Rows(lNextRow).RowHeight = 24: iPos = 0
</snip>

...where once RowHeight is set for the 1st row of data, the trigger is
reset to skip subsequent rows until the code processes the next sheet.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
As I stated, that's my preferred approach. I use a 'trigger' variable

(0/1) to set RowHeight for each sheet's 1st row of data...



Dim iPos% '//add to variable defs at top of Sub



<snip>...

If Not wks Is wksTarget Then

lLastRow = wks.Cells(wks.Rows.Count, "K").End(xlUp).Row

iPos = 1 '//initialize RowHeight trigger

For Each rng In wks.Range("K2:K" & lLastRow)

If Not rng.Value = 1 Then

lNextRow = lNextRow + 1

With wksTarget

'Set RowHeight for the 1st row of each wks data.

'then reset the trigger to skip subsequent rows.

If iPos > 0 Then .Rows(lNextRow).RowHeight = 24: iPos = 0

</snip>



..where once RowHeight is set for the 1st row of data, the trigger is

reset to skip subsequent rows until the code processes the next sheet.

Garry
Click to expand...

I tried the snip just to what the difference on the wksTarget was. It gave me fits trying to get the End If's and the End With's the For's & Next's in order so I gave up on it.

Like what I got just fine but was willing to take a look see at this snip.

I did find I needed to change:

For Each rng In wks.Range("K2:K" & lLastRow)
If Not rng.Value = 1 Then

to

For Each rng In wks.Range("K2:K" & lLastRow)
If Not rng.Value = 0 Then

In real life some "K2:K" &... values will be zero and no transfer is wanted for those rows. Actually as I type this I'm thinking it will need to be > 1, not = 0. At any rate that won't take a half dozen posts back and forth for me to get that fixed.<G>

Thanks, Garry.

Howard
 
Back
Top