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

  • Thread starter Thread starter Howard
  • Start date Start date
See below to know what code is new and where it inserts in the existing
sub...


<insert 1 line here>
iPos = 1 '//initialize RowHeight trigger


<insert 3 lines here>
'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

...where the entire snippet was intended to replace existing 6 lines via
copy/paste because those existing lines are within the snippet.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
See below to know what code is new and where it inserts in the existing

sub...







<insert 1 line here>

iPos = 1 '//initialize RowHeight trigger







<insert 3 lines here>

'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



..where the entire snippet was intended to replace existing 6 lines via

copy/paste because those existing lines are within the snippet.



--

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...

Okay, thanks I will give that a go.

I have to admit a gross error om my part releative to the dispersal of the "Product A, B, C" etc across sheet 1. Instead of that text being dispersed, it is the actual number in column K that needs to be dispersed.

So I'm pretty sure this is the heart of the "split and deal to the correct columns on sheet 1", taking the right most value from the C row entry usingthe key from above and all, to get it to the correct column/row. I just need it to disperse the Column K values to where the Column C values are going.

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

My Bad... I apologize.

Howard
 
??.. so just change this...

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

...to this...

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

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
??.. so just change this...



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



..to this...



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



--

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...

Awwww 'cmon, Garry! Thats too easy, there must be a way I can flounder about to get this done.<g>

I actually did try that at first but made the mistake of also changing this

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

to

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

which of course was a bust.

Well, I'm thinking it's where it needs to be. I'll throw some more data at it for further testing, but it's looking real fine right now.

Thanks.

Howard
 
Gee Howard, I didn't think you had much more time to "flounder" around
with this! So I went ahead and modified it to capture data if K is >0,
and to put K in place of C, and set RowHeight for the 1st row from each
sheet...

...should I wait a bit so you can do your 'floundering'?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Gee Howard, I didn't think you had much more time to "flounder" around

with this! So I went ahead and modified it to capture data if K is >0,

and to put K in place of C, and set RowHeight for the 1st row from each

sheet...



..should I wait a bit so you can do your 'floundering'?



--

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...

Don't wait... You are way due a break from this thread.

Howard
 
Oh.., okay then!

Sub Sheet2To5To1_v3()
Dim lNextRow&, lLastRow&, n&, rng, vPrds, vP, iPos%
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
iPos = 1
For Each rng In wks.Range("K2:K" & lLastRow)
If rng.Value > 0 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
.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, "K")
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
 
Back
Top