Hello!

The following code filters the values in a column for the value "y"
and then copies/combines the values of multiple cells in the same row
into other cells. There is probably a more efficient way of doing
this, but I haven't found it.

Here's the question - after successfully looping through all visible
rows, the code returns an error 91. As far as I can tell, it happens
when it reaches the last visible row. Is this why? How can I correct
it?

SrcEntRng.AutoFilter Field:=Range(PrefBAdd).Column,
Criteria1:="=y"
For Each MyCell In
Range(PrefBAdd).SpecialCells(xlCellTypeVisible)
' If MyCell.Value = "y" Then
MyCell.Offset(0, -13).Value =
Intersect(Rows(MyCell.Row), BAdd).Value _
& " " & Intersect(Rows(MyCell.Row),
BAdd.Offset(0, 1)).Value & " " _
& Intersect(Rows(MyCell.Row),
BAdd.Offset(0, 2)).Value & " " _
& Intersect(Rows(MyCell.Row),
BAdd.Offset(0, 3)).Value & " " _
& Intersect(Rows(MyCell.Row),
BAdd.Offset(0, 4)).Value
MyCell.Offset(0, -8).Value =
MyCell.Offset(0, 6).Value
MyCell.Offset(0, -7).Value =
MyCell.Offset(0, 7).Value
MyCell.Offset(0, -6).Value =
MyCell.Offset(0, 8).Value
MyCell.Offset(0, -5).Value =
MyCell.Offset(0, 9).Value
' End If
Next
SrcWS.AutoFilterMode = False

Hi Hector:

How does this work? Again, a solution that does just the trick and is
efficient, but I don't understand the nested transpose function. I've
never used Join (until now I didn't know it existed).
It's really that one line of code that I'd like clarification on.
Thank you!


Steven

On Aug 20, 6:23*pm, "Héctor Miguel"
wrote:
hi, !

i'm not so sure to guess your layout exactly (even to have requested all the information "pending")
(but) i would try to avoid (when possible) several nested for...next, so....

give a try to the following alternate and...

* With ActiveSheet
* * .Range("a1").AutoFilter Range(PrefBAdd).Column, "<y"
* * With .AutoFilter.Range
* * * For Each myCell In Range(HAdd).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
* * * * With Application
* * * * * myCell.Value = Join(.Transpose(.Transpose(myCell.Resize(, 5))), " ")
* * * * End With
* * * Next
* * End With
* End With

if any doubts (or further information)... would you please comment ?
regards,
hector.

__ previous __

it is "hard to see" what the (real) layout of your data is and where (by only "read" your variable names) -?-
could you expose some additional information ? (like):
- which is the range or the *current region* in your database ? (starting in A1 ?)
- is row1 only for titles ?
- how many columns are included ?
- which is the column to apply the autofilter criteria ?
- is your "PrfBAdd" range a fixed column or dynamically changed ?
- is all of these applied to the "active sheet" ?

Thank you for your time, I posed a different question on this group and got an answer that resolves both of my problems
- the resulting code is:

* * * * SrcEntRng.AutoFilter Field:=Range(PrefBAdd).Column, Criteria1:="<y"
* * * * DestCols = Range(Cells(1, Range(PrefBAdd).Column), Cells(SrcLast, Range(PrefBAdd).Column)). _
* * * * * * * * * * SpecialCells(xlCellTypeVisible).Count
* * * * For Each MyCell In Range(HAdd).SpecialCells(xlCellTypeVisible)
* * * * * * If Not MyCell.Value = "" Then
* * * * * * * * Do Until i = DestCols + 1
* * * * * * * * * * If MyCell.Row 1 Then
* * * * * * * * * * * * Set FirstCol = Intersect(Range(HAdd), Rows(MyCell.Row))
* * * * * * * * * * * * Data = ""
* * * * * * * * * * * * For ColOffset = 0 To 4
* * * * * * * * * * * * * * If ColOffset = 0 Then
* * * * * * * * * * * * * * * Data = FirstCol.Value
* * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * Data = Data & " " & _
* * * * * * * * * * * * * * * * *FirstCol.Offset(0, ColOffset)
* * * * * * * * * * * * * * End If
* * * * * * * * * * * * Next ColOffset

* * * * * * * * * * * * FirstCol.Value = Data
* * * * * * * * * * * * FirstCol.Formula = LTrim(FirstCol.Formula)
* * * * * * * * * * * * FirstCol.Formula = RTrim(FirstCol.Formula)
* * * * * * * * * * End If
* * * * * * * * i = i + 1
* * * * * * * * Exit Do
* * * * * * * * Loop
* * * * * * End If
* * * * Next

To answer some of your questions -

- which is the range or the *current region* in your database ? (starting in A1 ?)

The number of rows changes, but the columns are currently fixed to A:CW

- is row1 only for titles ?

Yes

- which is the column to apply the autofilter criteria ?

PrfBAdd is assigned by searching the header row for a specific field heading. Currently that is Column AJ
PrfBAdd is the autofilter column

- is all of these applied to the "active sheet" ?

Yes

Hector:

I made a revision as well. Not every cell in those 5 columns I am
joining together contain data -

MyCell.Formula = RTrim(Join(.Transpose(.Transpose(MyCell.Resize(,
5))), " "))

It shaves off the extra spaces that get tagged on to the right.

On Aug 21, 9:49*am, wrote:
Hi Hector:

How does this work? Again, a solution that does just the trick and is
efficient, but I don't understand the nested transpose function. I've
never used Join (until now I didn't know it existed).
It's really that one line of code that I'd like clarification on.
Thank you!

Steven

On Aug 20, 6:23*pm, "Héctor Miguel"
wrote:



hi, !

i'm not so sure to guess your layout exactly (even to have requested all the information "pending")
(but) i would try to avoid (when possible) several nested for...next, so...

give a try to the following alternate and...

* With ActiveSheet
* * .Range("a1").AutoFilter Range(PrefBAdd).Column, "<y"
* * With .AutoFilter.Range
* * * For Each myCell In Range(HAdd).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
* * * * With Application
* * * * * myCell.Value = Join(.Transpose(.Transpose(myCell.Resize(, 5))), " ")
* * * * End With
* * * Next
* * End With
* End With

if any doubts (or further information)... would you please comment ?
regards,
hector.

__ previous __

it is "hard to see" what the (real) layout of your data is and where (by only "read" your variable names) -?-
could you expose some additional information ? (like):
- which is the range or the *current region* in your database ? (starting in A1 ?)
- is row1 only for titles ?
- how many columns are included ?
- which is the column to apply the autofilter criteria ?
- is your "PrfBAdd" range a fixed column or dynamically changed ?
- is all of these applied to the "active sheet" ?

Thank you for your time, I posed a different question on this group and got an answer that resolves both of my problems
- the resulting code is:

* * * * SrcEntRng.AutoFilter Field:=Range(PrefBAdd).Column, Criteria1:="<y"
* * * * DestCols = Range(Cells(1, Range(PrefBAdd).Column), Cells(SrcLast, Range(PrefBAdd).Column)). _
* * * * * * * * * * SpecialCells(xlCellTypeVisible)..Count
* * * * For Each MyCell In Range(HAdd).SpecialCells(xlCellTypeVisible)
* * * * * * If Not MyCell.Value = "" Then
* * * * * * * * Do Until i = DestCols + 1
* * * * * * * * * * If MyCell.Row 1 Then
* * * * * * * * * * * * Set FirstCol = Intersect(Range(HAdd), Rows(MyCell.Row))
* * * * * * * * * * * * Data = ""
* * * * * * * * * * * * For ColOffset = 0 To 4
* * * * * * * * * * * * * * If ColOffset = 0 Then
* * * * * * * * * * * * * * * Data = FirstCol.Value
* * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * Data = Data & " " & _
* * * * * * * * * * * * * * * * *FirstCol.Offset(0, ColOffset)
* * * * * * * * * * * * * * End If
* * * * * * * * * * * * Next ColOffset

* * * * * * * * * * * * FirstCol.Value = Data
* * * * * * * * * * * * FirstCol.Formula = LTrim(FirstCol.Formula)
* * * * * * * * * * * * FirstCol.Formula = RTrim(FirstCol.Formula)
* * * * * * * * * * End If
* * * * * * * * i = i + 1
* * * * * * * * Exit Do
* * * * * * * * Loop
* * * * * * End If
* * * * Next

To answer some of your questions -

- which is the range or the *current region* in your database ? (starting in A1 ?)

The number of rows changes, but the columns are currently fixed to A:CW

- is row1 only for titles ?

Yes

- which is the column to apply the autofilter criteria ?

PrfBAdd is assigned by searching the header row for a specific field heading. Currently that is Column AJ
PrfBAdd is the autofilter column

- is all of these applied to the "active sheet" ?

Yes- Hide quoted text -

- Show quoted text -

And one other question (I'm going to drive you crazy in a bit) -

I've tried to use the following variation on your code to copy data
from 5 other columns (BAdd and 5 columns to the right) in the
worksheet but I keep getting a "FALSE" value in the HAdd cell
(MyCell). Can you help me understand why that is happening?

Sub JoinText()
Dim PrefBAdd As String
Dim HAdd As String
Dim BAdd As String
Dim FoundCell As Range
Dim MyCell As Range

HAdd = "W1:W600"
BAdd = "AK1:AK600"
PrefBAdd = "AJ1:AJ600"

With ActiveSheet
.Range("a1").AutoFilter Range(PrefBAdd).Column, "=y"
With .AutoFilter.Range
For Each MyCell In Range(HAdd).Offset(1).Resize(.Rows.Count - 1)
_
.SpecialCells(xlCellTypeVisible)
With Application
Set FoundCell = Cells(MyCell.Row, Range(BAdd).Column)
MyCell.Value = (FoundCell.Formula = RTrim(Join( _
.Transpose(.Transpose(FoundCell.Resize(,
5))), " ")))
End With
Next
End With
End With
End Sub

hi, !

__ 1 __
I made a revision as well. Not every cell in those 5 columns I am joining together contain data -
MyCell.Formula = RTrim(Join(.Transpose(.Transpose(MyCell.Resize(, 5))), " "))
It shaves off the extra spaces that get tagged on to the right.

1) and, what if you have more blank cells ?... RTrim won't remove middle spaces
try using the application trim (worksheet function) i.e.
MyCell.Formula = .Trim(Join(.Transpose(.Transpose(MyCell.Resize(, 5))), " "))

__ 2 __
How does this work? Again, a solution that does just the trick and is efficient
but I don't understand the nested transpose function. I've never used Join (until now I didn't know it existed).
It's really that one line of code that I'd like clarification on...

2) the first .Transpose builds a transposed array: rows2columns or columns2rows
second one restores rows from rows / columns from columns
after this, the array can be "joined" using the specified character

join is a vba function available since vba6 (xl 2000)

hth,
hector.

__ OP __
i'm not so sure to guess your layout exactly (even to have requested all the information "pending")
(but) i would try to avoid (when possible) several nested for...next, so...

give a try to the following alternate and...

With ActiveSheet
.Range("a1").AutoFilter Range(PrefBAdd).Column, "<y"
With .AutoFilter.Range
For Each myCell In Range(HAdd).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
With Application
myCell.Value = Join(.Transpose(.Transpose(myCell.Resize(, 5))), " ")
End With
Next
End With
End With

1) and, what if you have more blank cells ?... RTrim won't remove middle spaces
* * try using the application trim (worksheet function) i.e.
* * MyCell.Formula = .Trim(Join(.Transpose(.Transpose(MyCell.Resize(, 5))), " "))

There won't (likely) be middle spaces. The columns are address fields
that need to be concatenated into one column, and are added in data
entry - left to right. It is completed using an online form, dropped
into a datatable that we download from the server.

I'll definitely use .Trim instead.

hi, !

And one other question (I'm going to drive you crazy in a bit) -
I've tried to use the following variation on your code to copy data from 5 other columns
(BAdd and 5 columns to the right) in theworksheet but I keep getting a "FALSE" value in the HAdd cell (MyCell).
Can you help me understand why that is happening?

i don't know why are you trying to "work" with the .Formula property for the FoundCell -?-

try changing from:
MyCell.Value = (FoundCell.Formula = RTrim(Join( _
.Transpose(.Transpose(FoundCell.Resize(, 5))), " ")))
to:
MyCell.Value = RTrim(Join(.Transpose(.Transpose(FoundCell.Resize( , 5))), " "))

hth,
hector.

__ exposed code __
Sub JoinText()
Dim PrefBAdd As String
Dim HAdd As String
Dim BAdd As String
Dim FoundCell As Range
Dim MyCell As Range
HAdd = "W1:W600"
BAdd = "AK1:AK600"
PrefBAdd = "AJ1:AJ600"
With ActiveSheet
.Range("a1").AutoFilter Range(PrefBAdd).Column, "=y"
With .AutoFilter.Range
For Each MyCell In Range(HAdd).Offset(1).Resize(.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible)
With Application
Set FoundCell = Cells(MyCell.Row, Range(BAdd).Column)
MyCell.Value = (FoundCell.Formula = RTrim(Join( _
.Transpose(.Transpose(FoundCell.Resize(, 5))), " ")))
End With
Next
End With
End With
End Sub

On Aug 21, 12:13*pm, "Héctor Miguel"
wrote:
hi, !

And one other question (I'm going to drive you crazy in a bit) -
I've tried to use the following variation on your code to copy data from 5 other columns
(BAdd and 5 columns to the right) in theworksheet but I keep getting a "FALSE" value in the HAdd cell (MyCell).
Can you help me understand why that is happening?

i don't know why are you trying to "work" with the .Formula property for the FoundCell * *-?-

try changing from:
* * * * * *MyCell.Value = (FoundCell.Formula = RTrim(Join( _
* * * * * * * * * * * * * * * * * *.Transpose(.Transpose(FoundCell.Resize(, 5))), " ")))
to:
* * * * * *MyCell.Value = RTrim(Join(.Transpose(.Transpose(FoundCell.Resize( , 5))), " "))

hth,
hector.

__ exposed code __



Sub JoinText()
Dim PrefBAdd As String
Dim HAdd As String
Dim BAdd As String
Dim FoundCell As Range
Dim MyCell As Range
HAdd = "W1:W600"
BAdd = "AK1:AK600"
PrefBAdd = "AJ1:AJ600"
*With ActiveSheet
* *.Range("a1").AutoFilter Range(PrefBAdd).Column, "=y"
* *With .AutoFilter.Range
* * *For Each MyCell In Range(HAdd).Offset(1).Resize(.Rows.Count - 1) _
* * * * * * * * * * * * .SpecialCells(xlCellTypeVisible)
* * * *With Application
* * * * * *Set FoundCell = Cells(MyCell.Row, Range(BAdd).Column)
* * * * * *MyCell.Value = (FoundCell.Formula = RTrim(Join( _
* * * * * * * * * * * * * * * * * *..Transpose(.Transpose(FoundCell.Resize(, 5))), " ")))
* * * *End With
* * *Next
* *End With
*End With
End Sub- Hide quoted text -

- Show quoted text -

That makes sense.

I was trying to set the value of MyCell to the value of the Join for
FoundCell. Normally - MyCell.Value = FoundCell.Value, right? But I
wanted the FoundCell Value joined to 5 columns in the same row. I've
not worked with Join or Transpose so didn't quite have the syntax. I'm
getting the hang of it.

Thank you for your help!

Hello Hector:

Alright, I've used your code with inconsistent success. For some
reason, it does not alway copy over the values and I am not sure why.
I've monitored the code and stepped through it and have confirmed that
(by hovering or using MsgBox) the values I want are being selected,
they are not actually being entered into the cell. Here's the code and
definitions for variables -

SrcWS = active worksheet in the book the code is committed on
SrcHdrRng = A1:CW1
SrcLast = Last row of data in the worksheet, currently 1780
FNm = this becomes I1:I1780
HAdd = W1:W1780
BAdd = AK1:AK1780
PrefBAdd = AJ1:AJ1780
------------------------------------------
With SrcWS

'**** THIS FIRST PART WORKS ******
'* Set FNm
Set MyCell = SrcHdrRng.Find(What:="First Name")
FNm = Range(MyCell.Address, Cells(SrcLast,
MyCell.Column)).Address

Set MyCell = Nothing

.Range("A1").AutoFilter Range(FNm).Offset(0, 1).Column, "="
With .AutoFilter.Range
For Each MyCell In
Range(FNm).Offset(1).Resize(.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible)
With Application
MyCell.Value =
RTrim(Join(.Transpose(.Transpose(MyCell.Resize(, 2))), " "))
End With
Next
End With
.AutoFilterMode = False

FNm = vbNull
Set MyCell = Nothing

'**** THIS IS THE SECTION WHERE THE CODE STOPS CONCATENATING ****
'*Replaces Home address with preferred business address

'* Set BAdd
Set MyCell = SrcHdrRng.Find(What:="BusinessAddressLine1")
BAdd = Range(MyCell.Address, Cells(SrcLast,
MyCell.Column)).Address

Set MyCell = Nothing

'* Set PrefBAdd
Set MyCell = SrcHdrRng.Find(What:="BusinessPreferredAddress")
PrefBAdd = Range(MyCell.Address, Cells(SrcLast,
MyCell.Column)).Address

Set MyCell = Nothing

.Range("a1").AutoFilter Range(PrefBAdd).Column, "=y"
With .AutoFilter.Range
For Each MyCell In
Range(HAdd).Offset(1).Resize(.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible)
With Application
Set FoundCell = Cells(MyCell.Row,
Range(BAdd).Column)
MyCell.Value =
RTrim(Join(.Transpose(.Transpose(FoundCell.Resize( , 5))), " "))
For ColOffset = 0 To 3
MyCell.Offset(0, ColOffset + 5).Value = _
FoundCell.Offset(0, ColOffset +
6).Value
Next ColOffset
End With
Next
End With
.AutoFilterMode = False

'*Concatenates Home into one column for each
.Range("a1").AutoFilter Range(PrefBAdd).Column, "<y"
With .AutoFilter.Range
For Each MyCell In
Range(HAdd).Offset(1).Resize(.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible)
With Application
MyCell.Formula =
RTrim(Join(.Transpose(.Transpose(MyCell.Resize(, 5))), " "))
End With
Next
End With
.AutoFilterMode = False
End With

Nevermind, I made a stupid copy/paste mistake earlier in the code
where HAdd gets defined. It ended up referring to Column CC rather
than W, therefore I didn't see the fields being filled in.

All better now.


Thank you for your help Héctor!!!



Steven

hi, Steven !

Nevermind, I made a... copy/paste mistake earlier in the code ...
It ended up referring to Column CC rather W, therefore I didn't see the fields being filled in.
All better now.
Thank you for your help Héctor!!!

thanks to you, for the feed-back (and for "dare" to expose your name) :))

regards,
hector.