Today i have to make an announcement: in the near future I intend to migrate the blog to a new one with a new design and completely in english because I want to develop a better project and reach readers from Romania, but also from other countries. The content will remain the same: finance and accounting, Excel automations and apps, SQL, Access etc.
Now, let's talk about an Excel problem which i recently had to solve. In reality i had a worksheet with thousands of rows (so the manual work which could take days wasn't a solution), but for illustrating purposes i created a file with few rows and no confidential data :)
! Challenge: You have the data from Range("A2:E4"). Split the rows by company codes: for Each Company code separated by a character (; or , or / or -) automatically create a new row. The rest of the data from other columns remains the same for the new rows. Every Company Code string can have different lenght and betwen codes and separators can be spaces.
Initial:
Result:
My code for solving this is the following:
Sub split_rows()
'original code by Andrei Lungu
lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
counter_ch = 0
ismore = False
col_comp_code = "C"
Application.ScreenUpdating = False
For i = lr To 2 Step -1
Set check_cell0 = ActiveSheet.Range(col_comp_code & i)
check_cell = Replace(check_cell0, " ", "")
counter = 0
For j = 1 To Len(check_cell)
counter_ch = counter_ch + 1
activechar = Mid(check_cell, j, 1)
If activechar = "," Or activechar = ";" Or activechar = "/" Or activechar = "-" Then
ismore = True
Separator = activechar
counter = counter + 1
ActiveSheet.Rows(i).Offset(0).EntireRow.Insert
where_starts = j - (counter_ch - 1)
company_code = Mid(check_cell, where_starts, counter_ch - 1)
ActiveSheet.Range(col_comp_code & i) = company_code
counter_ch = 0
End If
Next j
'last comp code
If ismore = True Then
'find out the position of the last separator
last_sep = counter
char_no = 1
counter2 = 0
For k = 1 To Len(check_cell)
activechar2 = Mid(check_cell, k, 1)
char_no = char_no + 1
If activechar2 = "," Or activechar2 = ";" Or activechar2 = "/" Or activechar2 = "-" Then
counter2 = counter2 + 1
If counter2 = last_sep Then
last_sep_char_no = char_no
'MsgBox last_sep_char_no
End If
End If
Next k
'copy last company code
last_company_code = Right(check_cell, Len(check_cell) - last_sep_char_no + 1)
ActiveSheet.Range(col_comp_code & i).Offset(counter) = last_company_code
'copy rest of data
Do While counter > 0
ActiveSheet.Range("A" & i & ":B" & i).Offset(counter).Copy ActiveSheet.Range("A" & i & ":B" & i).Offset(counter - 1)
ActiveSheet.Range("D" & i & ":E" & i).Offset(counter).Copy ActiveSheet.Range("D" & i & ":E" & i).Offset(counter - 1)
counter = counter - 1
Loop
End If
ismore = False
counter_ch = 0
counter = 0
Next i
Application.ScreenUpdating = False
End Sub
If you have other ideas please share them in a comment.
The sample file can be downloaded from this location.
Subscribe to Un mod diferit de a privi Economia by Email
Citește în continuare ->