CODEWITHSUNDEEP
excelvba
PowerToYou
PowerToYou

Reputation: 23

Copy data from multiple columns into a single column

I have 3 columns A, B, C and I want to make a column D with values in A, B, C but it should include ">=", "<=" signs as well. The script I am working on does help me loop around columns and copy its data to a new column. Can anyone help me figure out how I can add those special characters at the beginning of the numbers in the cells? Thanks for any help. 

Sub Try()

With ActiveWorkbook.Sheets("Sheet1")
    For rw = 1 To .Rows.Count
        If (.Rows(rw).Columns("A:A").Value <> "") Then
            .Rows(rw).Columns("A:A").Copy .Range("D" & rw)
        End If
    Next rw
    .Columns("A:A").Delete

End With

End Sub

enter image description here

Upvotes: 0

Views: 1898

Answers (4)

DisplayName
DisplayName

Reputation: 13386

try this

Sub main()
    Dim iCol As Long, cell As Range, signs As Variant

    signs = Array(">=", "<=", "")
    For iCol = 1 To 3
        For Each cell In Columns(iCol).SpecialCells(xlCellTypeConstants, xlNumbers)
            cell.Value = signs(iCol - 1) & cell.Value                
        Next
    Next
End Sub

if your columns A, B and C not empty cells content is not a numeric one only, then you could use:

For Each cell In Columns(iCol).SpecialCells(xlCellTypeConstants)

while if it's some formula, then you could use:

For Each cell In Columns(iCol).SpecialCells(xlCellTypeFormulas)

Upvotes: 0

user8608712
user8608712

Reputation:

This worked for me:

Sub macro_test()


k = 1

For k = 1 To 3
t = 2
lr = ActiveSheet.Cells(100000, k).End(xlUp).Row

Do Until t > lr

If Cells(t, k).Value = “” Then GoTo  continue

If k = 1 Then Cells(t, 4).Value = ">=" & Cells(t, k).Value
If k = 2 Then Cells(t, 4).Value = "<=" & Cells(t, k).Value
If k = 3 Then Cells(t, 4).Value = "" & Cells(t, k).Value
continue:
t = t + 1

Loop

Next

End Sub

Upvotes: 0

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96753

With data in cols A through C, in D1 enter:

=IF(A1<>"",">="&A1,IF(B1<>"","<="&B1,C1))

and copy down:

enter image description here

EDIT#1:

To do this with VBA:

Sub PopulateFormulas()
    Dim N As Long, s As String

    s = "=IF(A1<>"""","">=""&A1,IF(B1<>"""",""<=""&B1,C1))"
    N = Range("A1").CurrentRegion.Rows.Count
    Range("D1:D" & N).Formula = s
End Sub

Upvotes: 3

dwirony
dwirony

Reputation: 5450

Probably not the most elegant solution (and you probably don't even need VBA for this, a formula would most likely suffice), but this does the trick:

Sub Test()

arr = Array(">=", "<=", "")

With ActiveWorkbook.Sheets("Sheet1")
    For cl = 1 To 3
        For rw = 2 To .Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
            If .Cells(rw, cl).Value <> "" Then
                .Cells(rw, 4).Value = arr(cl - 1) & .Cells(rw, cl).Value
            End If
        Next rw
    Next cl
End With

'If you still need to delete those columns at the end-
'ActiveWorkbook.Sheets("Sheet1").Columns("A:C").Delete xlShiftLeft
End Sub

pic1

Upvotes: 1

Related Questions