VBA - Insert Spilt Cell Value

0 votes

How do I simultaneously separate two ranges?

Only one of them was divided by the that I am using right now (thank you, Vbasic):

With ThisWorkbook.Sheets("Cell Splitter")
Dim Descriptions() As String, dUpper As Long, d As Long
Dim r As Long, rString As String
For r = .Cells(.Rows.Count, "K").End(xlUp).Row To 3 Step -1
rString = CStr(.Cells(r, "K").Value)

If InStr(rString, ",") > 0 Then
Descriptions = Split(rString, ",")
dUpper = UBound(Descriptions)

For d = dUpper To 0 Step -1
.Cells(r, "K").Value = Descriptions(d)
If d > 0 Then .Rows(r).Insert

Next d

End If

Next r

I tried adding another range into the code but got a "400" error.

For example: I added K:O or "K" & "O" (Which doesnt work). I only wanted to process only 2 columns.

What I wanted it to do:

From this:

enter image description here

To this:

enter image description here

Apr 1, 2023 in Others by Kithuzzz
• 38,010 points

1 answer to this question.

0 votes

Your desired outcome will not be produced by the code you posted. You would need to manage the insertion of rows if you wanted to add another column and use the same code, as I suggested in the remark. But you may give this a shot.

Dim r As Range, lr As Long, v, i As Integer

With Sheet1
  'this code will parse your text the same way as your initial code
  'but you can repeat this code and just replace the column, in this case K to O
  'it will yield the same result but as I've said it will not happen in the same time
  'but instead one after the other
  lr = .Range("K" & .Rows.Count).End(xlUp).Row
  Set r = .Range("K2:K" & lr)
  For i = lr To 2 Step -1
    v = Split(.Range("K" & i), ",")
    .Range("K" & i).Resize(UBound(v)).Insert xlDown, xlFormatFromLeftOrAbove
    .Range("K" & i).Resize(UBound(v) + 1) = Application.Transpose(v)

  ' repeat the exact code here but changing the column from K to whatever
End With
answered Apr 1, 2023 by narikkadan
• 63,420 points

Related Questions In Others

0 votes
1 answer

Excel VBA: Auto increment cell value after each printing

Print Copies of Single Worksheet With Increment Option ...READ MORE

answered Jan 22, 2023 in Others by narikkadan
• 63,420 points
0 votes
1 answer

VBA Excel: Draw line between cells based on cell value

In accordance with your description and with ...READ MORE

answered Feb 6, 2023 in Others by narikkadan
• 63,420 points
0 votes
1 answer

Create a hyperlink to a sheet with same name as the value in the selected cell in Excel through VBA

Credit to Spectral Instance who found the ...READ MORE

answered Feb 6, 2023 in Others by narikkadan
• 63,420 points
0 votes
1 answer

VBA - user input of row value to use in a cell range

Use this: Range("C" & c & ":I" & ...READ MORE

answered Feb 7, 2023 in Others by narikkadan
• 63,420 points
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 23,260 points
0 votes
2 answers

How to copy a formula horizontally within a table using Excel VBA?

Hi so basically, create an adjacent column ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,670 points
0 votes
1 answer

How to insert a picture into Excel at a specified cell position with VBA

Try this: With xlApp.ActiveSheet.Pictures.Insert(PicPath) With ...READ MORE

answered Oct 24, 2022 in Others by narikkadan
• 63,420 points
0 votes
1 answer

VBA Change Cell colors based on value, and it can deal with single cell and multiple cells changes

Before looping through all of the cells ...READ MORE

answered Jan 21, 2023 in Others by narikkadan
• 63,420 points
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP