VBA, Excel 2007, How to combine values from other columns into 1 with overwrite exist

[weenie]

Hello,

What I need to accomplish:

Main column D
want to combine columns E, F, G each will be separated with _ INTO column D cells
I don't want to override info existing in cells of Col D



OR


if possible to combine Col D with Col E; Col F with Col G

attached sheet there will be lots of empty cells which I don't know how to skip cells without affecting previous cell.

I feel like I might be overthinking how to go about this.
From attachment will see naming in most cells are different.
Plus how do add if those columns are empty then nothing to add to col D
I really don't know how to approach. I ne

Example:
Col D Col E Col F Col G
10x10 shld 1v llow
orange shld 1v
apple 1v

I would like Col D to look like:
10x10_shld_1v_llow
orange_shld_1v
apple_1v

Thanks
weenie

[mdmackillop]

Sub Test()
Dim r As Range
Set r = Columns(4).SpecialCells(2)
For Each cel In r
x = ""
For i = 0 To 3
If cel.Offset(, i) <> "" Then x = x & cel.Offset(, i) & "_"
Next i
cel.Formula = Left(x, Len(x) - 1)
Next cel
End Sub

[mana]

Sub test()

With Cells(1).CurrentRegion.Columns("H")
.Formula = "=SUBSTITUTE(TRIM(D1&"" ""&E1&"" ""&F1&"" ""&G1),"" "",""_"")"
.Value = .Value
.Offset(, -4).Value = .Value
.ClearContents
End With

End Sub

[weenie]

wow! Thanks

when I tested it stand-alone ran with no issues. now when running i experienced error
Run-time error '5':
Invalid procedure call or argument


Cel.Formula = Left(x, Len(x) - 1)

I would like to understand what line of code means

Thanks,
weenie

[weenie]

I did change code and ran with no issues. Not sure if size is an issue. When I tested less than 10,000 rows.
The file I'm trying to run has 610,000 rows to work through.

Sub test6() Dim r As Range
'take col G (7) & add to Col F (6) THEN clear contents col G
Set r = Columns(6).SpecialCells(2)
For Each Cel In r
x = ""
For i = 0 To 1
If Cel.Offset(, i) <> "" Then x = x & Cel.Offset(, i) & "_"
Cel.Offset(, i).ClearContents
Next i
Cel.Formula = Left(x, Len(x) - 1)
Next Cel
End Sub

Thanks,
weenie

[mdmackillop]

Cel.Formula = Left(x, Len(x) - 1)
It returns the text of x less the rightmost character ie the first characters to the length of x -1.

I would never dream of running a worksheet loop on 610,000 rows. You should advise the scale of the data when you post.

[weenie]

Is there another method you recommend?

original file working with was small. Didn't know some files would be larger than the file I was using to test code.

thanks,
weenie

[p45cal]

Adapting mdmackillop's code and bringing it into memory runs about 25 times faster:
Sub test3()
Set Rng = Intersect(Range("D:G"), Range("A2").CurrentRegion)
r = Rng.Value
For rw = 1 To UBound(r)
x = ""
For colm = 1 To 4
If Len(r(rw, colm)) > 0 Then
If x = "" Then x = r(rw, colm) Else x = x & "_" & r(rw, colm)
End If
r(rw, colm) = Empty
Next colm
r(rw, 1) = x
Next rw
Rng.Value = r
End Sub

[mdmackillop]

Thanks Pascal

[weenie]

Thank you p45cal.

weenie