• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Concatenate Cells According a condition

andresuru

New Member
Hello All,

First time posting threads here so hopefully you can help to determine the code for.

Basically I am doing a macro that each time a numeric cell be in Range (B3: B35000) Find the cell and cut/paste one cell to the left (easy part) but the part that I am stuck is the second one where I need to concatenate from the activecell +1 to the last cell with values (means the first row empty that appears). and this happens for each cell numeric only.

But please focus on the concatenate part, note I dont have a specific range to concatenate since the concatenate needs to be done in the cell which the number was and combinate all the cells under it until the last cell be Empty


76249


Sub EasyWay()

Application.ScreenUpdating = False



Dim cell As Range, celda As Range

Dim First As Long, Lastone As Long

'Dim Concatenate As String, str1 As String, str2 As String





Sheets("Data Dictionary").Select

Range("B:B").Select



First = ActiveCell + 1

Lastone = IsNumeric(cell) - 1



str1 = ActiveCell

str2 = ActiveCell(1, 0)





'On Error Resume Next





For Each cell In Range("B1:B350000")



If IsNumeric(cell) = False Or cell = Empty Then





Else



If IsNumeric(cell) = True Then



cell.Select

Selection.Cut

ActiveCell.Offset(0, -1).Select

ActiveSheet.Paste



ActiveCell.Offset(1, 1).Select







'HELPING TO CREATE CODE

'______________________________________________________________________________________________



**This code can be deleted and use the one of yours***



For i = First To Lastone



If Cells(1, 2) <> Empty Then



ActiveCell.Value = Cells(i, 2) & Cells(1 + 1, 2)



End If

Next i



'____________________________________________________________________________________________________

End If









End If

Next cell







'Call DeleteEmptyCells



End Sub







Sub DeleteEmptyCells2()



'Eliminas las filas en blanco en la columna D



Application.ScreenUpdating = False

Sheets("Data Dictionary").Select

Range("B:B").Select

Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete



End Sub
[Spoiler/]
 
andresuru
Please reread Forum Rules
There are useful hints and You should use those.
Based You sent picture, there are some challenges to get clear idea of You case.
You should able to send a sample Excel-file, with a sample data with expected results.

As well as, clear sentences if someone will use Cross-Posting.
 
Sorry for the issue, please close this thread and I will continue the post through only MR.Excel Forum only
 
andresuru
As You've reread Forum Rules:
Please follow:
  • Also if you have cross-posted and get an Solution elsewhere, have the courtesy of posting the Solution here so other readers can learn from the answer also, as well as stopping people wasting their time on your answered question.
 
Have a look at teh following code

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

If Intersect(Range("B3:B35000"), Target) Is Nothing Then Exit Sub

Dim break As Boolean
break = False

Dim myString As String
myString = ""

Dim i As Integer
i = 1

Do
   If Len(Target.Offset(i, 0)) = 0 Or IsNumeric(Target.Offset(i, 0)) Then Exit Do
      myString = myString & Target.Offset(i, 0).Text
      i = i + 1
Loop While break = False

Target.Offset(0, -1) = myString

Application.EnableEvents = True

End Sub
 
Back
Top