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
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
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/]
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/]