Example 14 - Merge multiple cell data
Private Sub CommandButton Merge Data _Click()
'Merge symbol cannot be empty
With ThisWorkbook.Worksheets ("Interface")
Dim mergetext As String
If . Cells(4, "C"). Value <> "" Then
mergetext = . Cells(4, "C"). Value
Else
MsgBox "Please enter merge symbol"
Exit Sub
End If
'Merge area cannot be empty
Dim mergerange As String
If . Cells(7, "C"). Value <> "" Then
mergerange = . Cells(7, "C"). Value
Else
MsgBox "Please enter merge area address"
Exit Sub
End If
'Clear the original result area
. Cells(10, "B"). Value = ""
'Combine data
Dim itemcell
Dim mergeresult As String
For each itemcell In ThisWorkbook.Worksheets("Data to be merged"). Range(mergerange)
If itemcell. Value <> "" Then
If mergeresult <> "" Then
mergeresult = mergeresult & mergetext & itemcell. Value
Else
mergeresult = itemcell. Value
End If
End If
Next
. Cells(10, "B"). Value = mergeresult
End With
End Sub
Example 15 - Insert empty row by text lookup specified column
Private Sub CommandButton insert _Click()
' Determine the workbook name, the worksheet name is not empty
With ThisWorkbook.Worksheets ("Interface")
If Trim(. Cells(2, "C"). Value) = "" Or Trim(. Cells(6, "C"). Value) = "" Or Trim(. Cells(10, "C"). Value) = "" _
Or Trim(. Cells(18, "C"). Value) = "" Or Trim(. Cells(14, "C"). Value) = "" Or Trim(. Cells(14, "D"). Value) = "" Then
MsgBox "Parameter cannot be empty"
Exit Sub
End If
On Error GoTo processing error
' Define variables
Dim wbname As String
Dim shname As String
wbname = Trim(. Cells(2, "C"). Value)
shname = Trim(. Cells(6, "C"). Value)
Dim matchcolumn As Long
Dim startnum As Long
Dim stopnum As Long
matchcolumn = Trim(. Cells(10, "C"). Value)
startnum = Trim(. Cells(14, "C"). Value)
stopnum = Trim(. Cells(14, "D"). Value)
Dim matchtext As String
matchtext = Trim(. Cells(18, "C"). Value)
End With
'Processing forms
With Workbooks(wbname). Worksheets(shname)
'Circular judgment (reverse)
Nothing to
For i = stopnum To startnum Step -1
If . Cells(i, matchcolumn) <> "" And . Cells(i, matchcolumn) = matchtext Then
. Rows(i). Insert
End If
Next i
End With
Workbooks(wbname). Save
MsgBox "Processing Complete"
Workbooks(wbname). Activate
ActiveWindow.WindowState = xlMaximized
Workbooks(wbname). Worksheets(shname). Activate
Workbooks(wbname). Worksheets(shname). Cells(1, 1). Select
Exit Sub
Processing error:
MsgBox Err.Description
End Sub