Split and transpose cell value
 

Sheet4 drop down in cell J8, will have these selections (example)

Alpha
Bravo
Charlie
Delta

Sheet5 column A will a have the same list in A2 and down.
Column B will have comma separated values like these examples.

one, two, three, four
bbb, xxx,xx
ccc, xxx, zz
ddd, xxx, qq

So "Alpha" in A2 would have "one, two, three, four" in B2,
"Bravo" would have "bbb, xxx,xx" in B3, etc. for the others.

I want a worksheet_change event macro in sheet4 to find the sheet4 J8 value over on sheet5 in column A and then split and transpose the associated value in column B to a list starting in C2.

When a new item is selected on sheet4 drop down in J8, the old list that was in sheet5 C2 is deleted and the new-found split and transformed list replaces it, again starting in C2.

I have this macro so far (not an event macro at present) that fails to make the split and transpose. If I can get the split and transpose line to work, I can write the delete old list and make the code into a event macro myself.

Can't seem to get that line correctly written.

Thanks for taking a look.

Howard

Sub Split_Transpose()
Dim oneRng As Range, ddFound As Range
Dim dDwn As String
Dim X As Variant


dDwn = Sheets("Sheet4").Range("J8")
Set oneRng = Sheets("Sheet5").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)


With Sheets("Sheet5")
Set ddFound = Sheets("Sheet5").UsedRange.Find(What:=dDwn, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Offset(, 1)
If Not ddFound Is Nothing Then


' X = Split(Range("A" & ddFound.Row).Offset(, 1).Value, ",")
Range("C2").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)

Else
MsgBox "No match found."
End If

End With


End Sub

Split and transpose cell value
 

On Tuesday, October 31, 2017 at 8:44:38 PM UTC-7, L. Howard wrote:
Sheet4 drop down in cell J8, will have these selections (example)

Alpha
Bravo
Charlie
Delta

Sheet5 column A will a have the same list in A2 and down.
Column B will have comma separated values like these examples.

one, two, three, four
bbb, xxx,xx
ccc, xxx, zz
ddd, xxx, qq

So "Alpha" in A2 would have "one, two, three, four" in B2,
"Bravo" would have "bbb, xxx,xx" in B3, etc. for the others.

I want a worksheet_change event macro in sheet4 to find the sheet4 J8 value over on sheet5 in column A and then split and transpose the associated value in column B to a list starting in C2.

When a new item is selected on sheet4 drop down in J8, the old list that was in sheet5 C2 is deleted and the new-found split and transformed list replaces it, again starting in C2.

I have this macro so far (not an event macro at present) that fails to make the split and transpose. If I can get the split and transpose line to work, I can write the delete old list and make the code into a event macro myself.

Can't seem to get that line correctly written.

Thanks for taking a look.

Howard

Sub Split_Transpose()
Dim oneRng As Range, ddFound As Range
Dim dDwn As String
Dim X As Variant


dDwn = Sheets("Sheet4").Range("J8")
Set oneRng = Sheets("Sheet5").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)


With Sheets("Sheet5")
Set ddFound = Sheets("Sheet5").UsedRange.Find(What:=dDwn, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Offset(, 1)
If Not ddFound Is Nothing Then


' X = Split(Range("A" & ddFound.Row).Offset(, 1).Value, ",")
Range("C2").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)

Else
MsgBox "No match found."
End If

End With


End Sub


False alarm...

Set ddFound = Sheets("Sheet5").UsedRange.Find(What:=dDwn, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Offset(, 1)

I removed the .Offset(, 1) from the FIND and it works. That was an attempt to go right to the offset of ddFound which, of course, did not work and I forgot to remove it.

Here is what is working for me now.

Howard

Sub Split_Transpose()
Dim oneRng As Range, ddFound As Range
Dim dDwn As String
Dim X As Variant



dDwn = Sheets("Sheet4").Range("J8")
Set oneRng = Sheets("Sheet5").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)


With Sheets("Sheet5")
Set ddFound = Sheets("Sheet5").UsedRange.Find(What:=dDwn, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not ddFound Is Nothing Then


X = Split(ddFound.Offset(, 1).Value, ",")
Sheets("Sheet5").Range("C2").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)

Else
MsgBox "No match found."
End If

End With


End Sub

Howard

Split and transpose cell value
 

Hi Howard,

Am Tue, 31 Oct 2017 21:19:10 -0700 (PDT) schrieb L. Howard:

Sub Split_Transpose()
Dim oneRng As Range, ddFound As Range
Dim dDwn As String
Dim X As Variant



dDwn = Sheets("Sheet4").Range("J8")
Set oneRng = Sheets("Sheet5").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)


With Sheets("Sheet5")
Set ddFound = Sheets("Sheet5").UsedRange.Find(What:=dDwn, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not ddFound Is Nothing Then

X = Split(ddFound.Offset(, 1).Value, ",")
Sheets("Sheet5").Range("C2").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)

Else
MsgBox "No match found."
End If

End With


End Sub

there are some superfluous lines in your code.

Try:

Sub Split_Transpose()
Dim oneRng As Range, ddFound As Range
Dim dDwn As String
Dim X As Variant

dDwn = Sheets("Sheet4").Range("J8")

With Sheets("Sheet5")
Set ddFound = .Range("A:A").Find(What:=dDwn, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not ddFound Is Nothing Then
X = Split(ddFound.Offset(, 1).Value, ",")
.Range("C2").Resize(UBound(X) + 1).Value = Application.Transpose(X)
Else
MsgBox "No match found."
End If

End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Split and transpose cell value
 

On Wednesday, November 1, 2017 at 5:11:20 AM UTC-7, Claus Busch wrote:
Hi Howard,

Am Tue, 31 Oct 2017 21:19:10 -0700 (PDT) schrieb L. Howard:

Sub Split_Transpose()
Dim oneRng As Range, ddFound As Range
Dim dDwn As String
Dim X As Variant



dDwn = Sheets("Sheet4").Range("J8")
Set oneRng = Sheets("Sheet5").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)


With Sheets("Sheet5")
Set ddFound = Sheets("Sheet5").UsedRange.Find(What:=dDwn, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not ddFound Is Nothing Then

X = Split(ddFound.Offset(, 1).Value, ",")
Sheets("Sheet5").Range("C2").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)

Else
MsgBox "No match found."
End If

End With


End Sub

there are some superfluous lines in your code.

Try:

Sub Split_Transpose()
Dim oneRng As Range, ddFound As Range
Dim dDwn As String
Dim X As Variant

dDwn = Sheets("Sheet4").Range("J8")

With Sheets("Sheet5")
Set ddFound = .Range("A:A").Find(What:=dDwn, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not ddFound Is Nothing Then
X = Split(ddFound.Offset(, 1).Value, ",")
.Range("C2").Resize(UBound(X) + 1).Value = Application.Transpose(X)
Else
MsgBox "No match found."
End If

End With
End Sub


Regards
Claus B.

Hi Claus,

Yes, some lines not needed that I had not cleaned up.

Yours is, of course, quite tidy.

Thanks much.

Howard