Help Modifying Concatenate Formula

[odoualex]

Hello Everyone!

I have a formula in a macro to concatenate multiples columns cells with a dash (-) as a delimiter, it work fine when all the cells have value, but when some cells are blank the result will have the dashes in the corresponding place of the empty cells values like:

Examples:

1- Right - Left - Superior - Inferior ( this is the result in case the four cells have a value)

2-Right - - - (this the result when the first cell is the only one with value)

3- - - - Inferior (this is the result when the last cell is the only one with value)

This is the formula I have:
"=Data!G2&"" - ""&Data!H2&"" - ""&Data!I2&"" - ""&Data!J2"

I've been trying to modify it using other similar posting but no success

Can anyone help me, please!

I really appreciate any help!

Respectfully,

Alex

[sandy666]

maybe: =Data!G2&" - "&Data!H2&" - "&Data!I2&" - "&Data!J2

[TudyBTH]

Put here all code of macro

[mehmetcik]

In the latest version of excel you would use Textjoin to dpo what you need.

I will write a user defined function to do the same thing for you.

Paste the code into a standard macro module and use the formula:-

=Textjoin("-",True,Range)

to get your result.

I will programme the Textjoin function to work as described in this link:

https://support.office.com/en-gb/art...3-0e8fc845691c

It will take me a few minutes.

This is written to work on a horizontal range as you described.

Function Textjoin(dlim As String, flag As Boolean, range As range)

A = range.Value

For Count = 1 To UBound(A, 2)

Textjoin = Textjoin & A(1, Count)

If flag = False Or A(1, Count) <> "" Then Textjoin = Textjoin & dlim
Next
Textjoin = Left(Textjoin, Len(Textjoin) - Len(dlim))

End Function

NB not fully tested because I cannot use the function name Textjoin on my pc.

Tested thus:-

Function TJoin(dlim As String, flag As Boolean, range As range)

A = range.Value

For Count = 1 To UBound(A, 2)

TJoin = TJoin & A(1, Count)

If flag = False Or A(1, Count) <> "" Then TJoin = TJoin & dlim
Next
TJoin = Left(TJoin, Len(TJoin) - Len(dlim))

End Function

Ok

This version works for all types of range. Eg A1 to E1, A1 to A5 ans also A1 to E5.

Function TJoin(dlim As String, flag As Boolean, range As range)

A = range.Value

For Count1 = 1 To UBound(A)
For Count = 1 To UBound(A, 2)
TJoin = TJoin & A(Count1, Count)

If flag = False Or A(Count1, Count) <> "" Then TJoin = TJoin & dlim
Next
Next

TJoin = Left(TJoin, Len(TJoin) - Len(dlim))

End Function

[AlKey]

Use this one to avoid empty cells

=SUBSTITUTE(TRIM(Data!G2&" "&Data!H2&" "&Data!I2&" "&Data!J2)," ","-")

[odoualex]

Hi Everyone!,

Thank you very much for all the responses, is amazing the great people in this forum!

Sandy that's the original formula I had but do not skip the blank cells.

mehmetcik, I have a lot to learn from you!

I'm attaching the sample workbook so you can have a better understanding, in the visit data tab the empty cells from the data tab show the dashes, it does not look good when it run 1000 times


Thank you for your support on this matter!

I really appreciate all your help!

Respectfully,

Alex

[mehmetcik]

I had a look at your Userform.

I would like to say that I have found a neat way of loading my userform data from the worksheet and writing it back.

Imagine you have 65 textboxes and comboboxes in your worksheet.

the textboxes and comboboxes write their data to random columns

Using your method I would have to write 65 separate program lines.

I do it using 6.

First rename the textboxes and comboboxes so the name reflects the column number that stores the data.

ie if you have a Combobox that needs to store its data in column D then name ie Combobox4 (Column 4 is Column D)

On Error Resume Next
For Count = 1 to 65
Cells(R,Count).value = Me.controls("Textbox" & Count).value
Cells(R,Count).value = Me.controls("Combobox" & Count).value
Next
On Error Goto 0

[odoualex]

mehmetcik!

I know my user form and the codes are very basic, but don't how to apply your codes??

I really appreciate your time and your suggestions!

Respectfully,

Alex

[odoualex]

TudyBTH,

thank you for your interest in helping me, I really appreciate it!

this is the whole code:

 Set WS3 = Worksheets("Visit Data")
        LastRow3 = WS3.Range("A" & Rows.Count).End(xlUp).Row
        With WS3
          For i2 = 2 To LastRow3
          
          If Len(Trim(.Range("A" & i2).Value)) <> 0 Then
            .Range("C3:C" & LastRow3).Value = "=Data!G2&"" - ""&Data!H2&"" - ""&Data!I2&"" - ""&Data!J2"
           .Range("C3:C" & LastRow3).Value = .Range("C3:C" & LastRow3).Value
       End If
            
          Next i2
          
        End With

Thank you again for your time,

Respectfully,

Alex

[odoualex]

mehmetcik!

I will try to redo the formula based on you suggestion and also the user form!

thank you very much for pointing me to this way!

I really appreciate it.

Respectfully,

Alex

[odoualex]

mehmetcik!

I added the Tjoin function you wrote for me to a module and when calling it from the macro it's giving me #Value! error.

what I'm doing wrong?

Thank you in advance for your time!

Respectfully,

Alex

[odoualex]

Alkey,

I changed the formula per your recommendation but it give me Run-time error 1004, application-defined or object-defined error.
this is the whole portion of the code:

 Set WS3 = Worksheets("Visit Data")
        LastRow3 = WS3.Range("A" & Rows.Count).End(xlUp).Row
        With WS3
          For i2 = 2 To LastRow3
          
          If Len(Trim(.Range("A" & i2).Value)) <> 0 Then
            .Range("C3:C" & LastRow3).Value = "=SUBSTITUTE(TRIM(Data!G2&"" ""&Data!H2&"" ""&Data!I2&"" ""&Data!J2),"" "",""-"")"""
           .Range("C3:C" & LastRow3).Value = .Range("C3:C" & LastRow3).Value
       End If
            
          Next i2
          
        End With

can you help me to correct the error?

Thank you for looking at this and your suggestion.

Respectfully,

Alex

[TudyBTH]

Hi,

I can`t test the code without the entire file, so try to change your code with this and test it

Set WS3 = Worksheets("Visit Data")
        LastRow3 = WS3.Range("A" & Rows.Count).End(xlUp).Row
        WS3.Range("C3:C" & LastRow3).Value = ""
        Dim iCol#
        For i2 = 2 To LastRow3
            If Len(Trim(WS3.Range("A" & i2).Value)) <> 0 Then
                For iCol = 0 To 3
                    If Sheets("Data").Range("G2").Offset(, iCol) <> "" Then _
                    WS3.Range("C3:C" & LastRow3).Value = WS3.Range("C3:C" & LastRow3).Value _
                    & Sheets("Data").Range("G2").Offset(, iCol) & " - "
                Next iCol
                If WS3.Range("C3:C" & LastRow3).Value <> "" Then _
                WS3.Range("C3:C" & LastRow3).Value = Left(WS3.Range("C3:C" & LastRow3).Value, _
                Len(WS3.Range("C3:C" & LastRow3).Value) - 3)
            End If
        Next i2

[odoualex]

TudyBTH,

Thank you for your response, I really appreciate your valuable time!

I replace the code and is giving me error 13

this is the whole codes, if you see I need to modify the formula for 9 fields,

      Dim LastRow1 As Variant
    Dim LastRow2 As Variant
    Dim LastRow3 As Variant
    Dim LastRow4 As Variant
    Dim LastRow5 As Variant
    Dim LastRow6 As Variant
    Dim LastRow7 As Variant
    Dim LastRow8 As Variant
    Dim LastRow9 As Variant
    Dim LastRow10 As Variant
    Dim LastRow11 As Variant
    Dim LastRow12 As Variant
    Dim LastRow13 As Variant
    Dim LastRow14 As Variant
    Dim i2 As Long
    Dim WS1 As Worksheet
    Dim WS3 As Worksheet
    Dim ws4 As Worksheet
    Dim ws5 As Worksheet

Sub VisitDataDescriptionConcatenation()
    
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Sheets("Data").Visible = True
    
 Set WS1 = Worksheets("Visit Data")
 
        LastRow1 = WS1.range("A" & Rows.Count).End(xlUp).Row
        With WS1
          For i2 = 2 To LastRow1
          
          If Len(Trim(.range("A" & i2).Value)) <> 0 Then
            .range("A3:A" & LastRow1).Value = "=Data!A2&"" ""&Data!B2"
           .range("A3:A" & LastRow1).Value = .range("A3:A" & LastRow1).Value
       End If
            
          Next i2
          
        End With
        
        
  Set ws2 = Worksheets("Visit Data")
        LastRow2 = ws2.range("A" & Rows.Count).End(xlUp).Row
        With ws2
          For i2 = 2 To LastRow2
          
          If Len(Trim(.range("A" & i2).Value)) <> 0 Then
            .range("B3:B" & LastRow2).Value = "=Data!C2&"" - ""&Data!D2"
           .range("B3:B" & LastRow2).Value = .range("B3:B" & LastRow2).Value
       End If
            
          Next i2
          
        End With
 
Set WS3 = Worksheets("Visit Data")
        LastRow3 = WS3.range("A" & Rows.Count).End(xlUp).Row
        WS3.range("C3:C" & LastRow3).Value = ""
        Dim iCol#
        For i2 = 2 To LastRow3
            If Len(Trim(WS3.range("A" & i2).Value)) <> 0 Then
                For iCol = 0 To 3
                    If Sheets("Data").range("G2").Offset(, iCol) <> "" Then _
                    WS3.range("C3:C" & LastRow3).Value = WS3.range("C3:C" & LastRow3).Value _
                    & Sheets("Data").range("G2").Offset(, iCol) & " - "
                Next iCol
                If WS3.range("C3:C" & LastRow3).Value <> "" Then _
                WS3.range("C3:C" & LastRow3).Value = Left(WS3.range("C3:C" & LastRow3).Value, _
                Len(WS3.range("C3:C" & LastRow3).Value) - 3)
            End If
        Next i2
 
 Set ws4 = Worksheets("Visit Data")
        LastRow4 = ws4.range("A" & Rows.Count).End(xlUp).Row
        With ws4
          For i2 = 2 To LastRow4
          
          If Len(Trim(.range("A" & i2).Value)) <> 0 Then
            .range("D3:D" & LastRow4).Value = "=Data!K2&"" - ""&Data!L2&"" - ""&Data!M2"
           .range("D3:D" & LastRow4).Value = .range("D3:D" & LastRow4).Value
       End If
            
          Next i2
          
        End With
 
 Set ws5 = Worksheets("Visit Data")
        LastRow5 = ws5.range("A" & Rows.Count).End(xlUp).Row
        With ws5
          For i2 = 2 To LastRow5
          
          If Len(Trim(.range("A" & i2).Value)) <> 0 Then
            .range("E3:E" & LastRow5).Value = "=Data!N2&""-""&Data!O2&""  ""&Data!P2"
           .range("E3:E" & LastRow5).Value = .range("E3:E" & LastRow5).Value
       End If
            
          Next i2
          
        End With
        
         Set ws6 = Worksheets("Visit Data")
        LastRow6 = ws5.range("A" & Rows.Count).End(xlUp).Row
        With ws6
          For i2 = 2 To LastRow6
          
          If Len(Trim(.range("A" & i2).Value)) <> 0 Then
            .range("F3:F" & LastRow6).Value = "=Data!Q2&"" x ""&Data!R2&"" ""&Data!S2"
           .range("F3:F" & LastRow6).Value = .range("F3:F" & LastRow6).Value
       End If
            
          Next i2
          
        End With
        
         Set ws7 = Worksheets("Visit Data")
        LastRow7 = ws5.range("A" & Rows.Count).End(xlUp).Row
        With ws7
          For i2 = 2 To LastRow7
          
          If Len(Trim(.range("A" & i2).Value)) <> 0 Then
            .range("G3:G" & LastRow7).Value = "=Data!E2&"" - ""&Data!F2"
           .range("G3:G" & LastRow7).Value = .range("G3:G" & LastRow7).Value
       End If
            
          Next i2
          
        End With
        
         Set ws8 = Worksheets("Visit Data")
        LastRow8 = ws5.range("A" & Rows.Count).End(xlUp).Row
        With ws8
          For i2 = 2 To LastRow8
          
          If Len(Trim(.range("A" & i2).Value)) <> 0 Then
            .range("H3:H" & LastRow8).Value = "=Data!W2&"" - ""&Data!X2"
           .range("H3:H" & LastRow8).Value = .range("H3:H" & LastRow8).Value
       End If
            
          Next i2
          
        End With
        
        
        
         Set ws9 = Worksheets("Visit Data")
        LastRow9 = ws5.range("A" & Rows.Count).End(xlUp).Row
        With ws9
          For i2 = 2 To LastRow9
          
          If Len(Trim(.range("A" & i2).Value)) <> 0 Then
            .range("I3:I" & LastRow9).Value = "=Data!T2&"" - ""&Data!U2&"" - ""&Data!V2"
           .range("I3:I" & LastRow9).Value = .range("I3:I" & LastRow9).Value
       End If
            
          Next i2
          
        End With
        
           
           'find range
         Dim cell As range
         Dim selectRange As range
        'This one work perfect!
        For Each cell In ActiveSheet.range("N24:O1000")
        If (cell.Value = "") Then On Error Resume Next

        If (cell.Value <> "") Then
            If selectRange Is Nothing Then
                Set selectRange = cell
            Else
                Set selectRange = Union(cell, selectRange)
            End If
        End If
    Next cell

'    selectRange.Select
'
'    Selection.Replace What:=" - ", Replacement:="" & Chr(10) & "", LookAt:=xlPart, _
'        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'        ReplaceFormat:=False
'
'
'    selectRange.Select
            
    selectRange.Select
   Dim rng As range
   Selection.EntireRow.AutoFit
   For Each rng In Selection.Rows
     rng.RowHeight = rng.RowHeight + 25
   Next rng
   Selection.VerticalAlignment = xlCenter
   
   
     Dim FirstCell As range
 Dim LastCell As range
 Dim MyRange As range
 Dim MyRow As range
 Dim ws As Worksheet
 
 Set LastCell = Cells(Cells.Find(what:="*", SearchOrder:=xlRows, _
 SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
 Cells.Find(what:="*", SearchOrder:=xlByColumns, _
 SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
Set FirstCell = Cells(Cells.Find(what:="*", After:=LastCell, SearchOrder:=xlRows, _
 SearchDirection:=xlNext, LookIn:=xlValues).Row, _
 Cells.Find(what:="*", After:=LastCell, SearchOrder:=xlByColumns, _
 SearchDirection:=xlNext, LookIn:=xlValues).Column)
 range("A3", LastCell).Select
 
 'Step1:  Declare your variables.
    
    
'Step 2:  Define the target Range.
    Set MyRange = Selection
    Set ws = ActiveSheet
    'ws.Unprotect Password:="1266"
    
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

'Step 3:  Start looping through the range.
    For Each MyRow In MyRange.Rows

'Step 4:  Check if the row is an even number.
    If MyRow.Row Mod 2 = 0 Then
    
'Step 5:  Apply appropriate alternate color.
    
    MyRow.Interior.ThemeColor = xlThemeColorAccent1
    MyRow.Interior.TintAndShade = 0.799981688894314
    MyRow.Interior.PatternTintAndShade = 0
        
    Else
    
    MyRow.Interior.ColorIndex = 2
    End If
    

'Step 6:  Loop back to get next row.

    Next MyRow
    
    Sheets("Data").Visible = xlVeryHidden
    
    Rows("1:1").Select
    Selection.RowHeight = 75.5
    
 range("XFD1").Select
 
 ActiveWindow.Zoom = 67
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
 
 
End Sub

Also attached the workbook so you can take a look at how is looking.

Thank again, I really need to solve this or will have to delete the extra delimiters dashes or x by hand?

Respectfully,

Alex

[TudyBTH]

Hi,

I found several problems in your code and I preferred to completely rewrite it.
Please check that all data is entered in the right place

[odoualex]

Hi TudyBTH,

It's all brand new, I don't have enough knowledge to read through it, but work flawless!

Thanks again!

Alex

[odoualex]

Hi TudyBTH,

When I try to delete the entries it show error message 1004, but remove one row at the time if I end the debug multiples times until it clears all, also how can I removed the filter?, I will keep testing it but it's great!

One more thing that I notice is that the Quadrant location, area location and anatomical location are not been populated in the column D which is "Location", and the Clock H. and Lock Unit should be populated in column E is now populating in Column D, I will try to trace the code to see if I can corrected.

Thanks again for your time, I really appreciated!

Respectfully,

Alex

[odoualex]

Hi TudyBTH,

Wao!!!, it's amazing what you did to this project, you are brilliant!!!

Everything is perfect, I really own you this one.

Good bless you.

Respectfully,

Alex

[odoualex]

Hi TudyBTH,

what I see is that if the location detail have not data then the location get in the right place but if both have data then the location data gets override with the location detail. beside that the rest is perfect!

thank you for your time!

Respectfully,

Alex

[TudyBTH]

I corrected the problem in column D and the problem of erasing

[odoualex]

Yes!!, Really nice work!!

I appreciated your help.

I can close this as solved thanks to you!

Respectfully,

Alex

[TudyBTH]

Also try this version

[odoualex]

Hi,

I see the difference in this version, each descriptor is display in a separate line, which is not bad for some fields but not for others like the location details, length, quantity and duration. the first version is better because it allow to enter the data as it is read in the medical record.

in the previous version, I forgot to concatenate the column A with the dash (-) when two selection are made, but I will try to see if I can fixed.

Thank you again for your time and dedication to this project!

Respectfully,

Alex

[TudyBTH]

I have modified

[odoualex]

It's giving me error in this portion of the code: Invalid use of property "Then lr.Cells (1)"

 End If
    lr.Cells(1) = cmbAnat1.Value
    If cmbAnat2.Value <> "" Then lr.Cells (1) & " - " & cmbAnat2.Value 'Eye middle (col A)

Thanks,

Alex

[TudyBTH]

If cmbAnat2.Value <> "" Then lr.Cells(1) = lr.Cells(1) & " - " & cmbAnat2.Value 'Eye middle (col A)

[odoualex]

I think that the error is because it can't find the "cmbAnat1", I don't see it in the formula where the error is happening, but don't know how to fix it, could you try?


Thank you for your time!

Respectfully,

Alex

[TudyBTH]

Try now. I fixed it (I hope)

[odoualex]

Yes! you did it!

It's perfect, I appreciate your help!

Respectfully,

Alex

[odoualex]

TudyBTH,

Hope everything is alright!

I've been working on another similar project called "Testing" which has the same structure and similar values and been trying to modify your codes but they are too advance for my knowledge and running out of time for the presentation of this possible solution.

I really need your help again. I redesign the user form and the tables.

could you help me with the codes? Please.

Thank you in advance for your valuable time!

I had attach the file.

Respectfully,

Alex

[TudyBTH]

Hi,

Try now

[odoualex]

TudyBTH,

It's perfect!

You save me one more time!

God Bless you Man!

Respectfully,

Alex

[odoualex]

TudyBTH,

Hope everything is ok.

I need your help one more time, in column D is showing a space, dash, space in front of the entry when the cmbQDR is empty, I need it to be removed, I've been trying, but I cant.

Will you help me please!

I have attached the excel file for illustration. It's probably a simple fix, but I have try with other codes but doesn't work.

Thank you very much in advance for your time.

Respectfully,


Alex

[TudyBTH]

Hi Alex,

I've modified the code. Now the dash should disappear.

[odoualex]

Hi TudyBTH,

Great!, it is perfect now, your help is a great deal to my project!

Respectfully,

Alex