How to combine three columns into one and leave out empty cells? - excel

Hello I need to advice some formulas on my problem:
How can I combine two, three or more columns into single one column?
And if in columns are "empty" cells I want to skip these cells inside of that single one column.
But be aware! This is the problem. All columns are contains another formulas. So these "empty" cells are in fact contains my another formulas with result ="".
Here is example of what I want to get - in column E:
EDIT:
New functions like TOCOL are not available in my Microsoft Office 365 MSO: 16.0.14326.21092 (32 bit).

You can use:
Formula in E2:
=TOCOL(IF(A2:C10="",NA(),A2:C10),3,1)
Note that just =TOCOL(A2:C10,3,1) is not going to cut it if these cells hold an empty string "".

If your data is not very huge use:
=FILTERXML("<t><s>"&TEXTJOIN("</s><s>",1,TRANSPOSE(A2:C10))&"</s></t>","//s")
With VBA:
Option Explicit
Sub To_Col()
Dim lngR As Long, lngC As Long, varV, lngRow As Long, lngCol As Long
varV = [A2:C10]
With ActiveCell
lngRow = .Row
lngCol = .Column
End With
For lngC = 1 To UBound(varV, 2)
For lngR = 1 To UBound(varV)
If varV(lngR, lngC) <> "" Then
Cells(lngRow, lngCol).Value = varV(lngR, lngC)
lngRow = lngRow + 1
End If
Next lngR
Next lngC
End Sub
place in E2 and launch macro, change [A2:C10] with your real range

Related

How do I format individual cell types based on column heading?

I have a table that has a heading in row one and a unit type in row two. These unit types are values such as $, %.
I would like to apply number formatting and also rounding to the cells.
The code I have below reads the column and applies the formatting to the cell, but I cannot figure out how to round the number. Any suggestions? Thanks
Sub Format()
Dim lngCol As Long, i As Long
Dim str As String
lngCol = Cells(2, Columns.Count).End(xlToLeft).Column
For i = 1 To lngCol
Select Case Cells(2, i)
Case "$": Columns(i).Style = "Currency"
Case "%": Columns(i).Style = "Percent"
End Select
Next
End sub
Try something like this, you can adapt it as needed ...
Public Sub FormatCellsBasedOnString()
Dim lngToCol As Long, lngCol As Long, lngToRow As Long
With Sheet1
lngToCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For lngCol = 1 To lngToCol
lngToRow = .Cells(.Rows.Count, lngCol).End(xlUp).Row
.Range(.Cells(3, lngCol).Address & ":" & .Cells(lngToRow, lngCol).Address).NumberFormat = .Cells(2, lngCol)
Next
End With
End Sub
It uses the number format in the 2nd row of the column to format the cells beneath it. the options are endless really. Format a cell to what you want, then go to Custom in the cell formatting and use that string to format the cell using that macro concept.
I hope that makes sense.

Ghost values in the cells

I seem to have a strange problem as some ghost values have entered my file. I got this file from someone but looks like file has seen several deletion, copy pastes etc. Please see attached image.
It shows ghost values in cell J186 and the values returned by various IS*** functions on cell j186. Such values are there in several columns in the file and I am sure they are consuming a lot of Filesize and the file is crashing every now and then. The file is 100 MB.
For example, when I select any cell in column L say Cell L56 and press Ctrl+Down, the cursor gets stuck in the cell L186 even when there is no value. If I select the cells L3:L186 and manually enter delete, something gets deleted (I cant see) and then the range functions as a normal range (i.e. If i select any random cell in that range and do a Ctrl+Down, it goes to the last row in Excel Row 1048576) Any cell in the range upto L186 shows the same behaviour as cell J186.
Is there a way to write a VBA code to identify such cells and clear contents of such cells?
Thanks in advance.
Yes, there is something strange here ..... zero length cells that are not actually blank (when tested with SpecialCells(xlBlank)
On your sample file =CODE(A117) returns #VALUE. Yet the cell is not blank
This array based code provides a very quick way of turning the cells to truely blank
Sub QuickReplace()
Dim rng1 As Range
Dim X
Dim lngRow As Long
Dim lngCol As Long
ActiveSheet.UsedRange
X = ActiveSheet.UsedRange.Value2
For lngRow = 1 To UBound(X, 1)
For lngCol = 1 To UBound(X, 2)
If Len(X(lngRow, lngCol)) = 0 Then X(lngRow, lngCol) = vbNullString
Next
Next
ActiveSheet.UsedRange.Value2 = X
End Sub
This code was successful. But the file size did not decrease much.
Sub cleancolumns()
Dim i As Integer
Dim j As Integer
Dim Rng As Range
j = 1
Do While j < 5010
Set Rng = Range(Cells(5, j), Cells(186, j))
If WorksheetFunction.Sum(Rng) = 0 Then
Rng.Select
Selection.ClearContents
j = j + 1
Else
j = j + 1
End If
Loop
ActiveWorkbook.Save
End Sub
There are a million cells in all, also counting the above ranges where full range is "". searching each cell one by one is very slow. Hence I did the above workaround.
The above code checks for the sum of the range and if the sum of the range is zero it is assumed to contain ""'s and clears contents. Else it skips the column and checks for the next column.
However, this does not remedy a situation where there are few genuine values and the rest are ""'s. These also have to be taken into account in a separate If statement i guess. That will make it very slow but doing this appears to be unavoidable.
Update based on Brettdj's response
The following variant of Brettdj's code worked. usedrange appeared to be larger than what my 6GB computer could handle. So I broke the data chunk by chunk to avoid "Out of memory" error. Also there were some error values which had to be removed before the Len function was applied. Now the file sizes have shrunk by a third (mainly by replacing 0's by blanks - there were too many). Thankfully the ghosts seem to have been busted.
Sub QuickReplace1()
Dim rng1 As Range
Dim X As Variant
Dim lngRow As Long
Dim lngCol As Long
' took no more than 500 columns at a time not to risk file crashing. Changed the values manually to clear chunk by chunk
Set rng1 = Range(Cells(1, 3501), Cells(7500, 4000))
X = rng1.Value2
For lngRow = 1 To UBound(X, 1)
For lngCol = 1 To UBound(X, 2)
If IsError(X(lngRow, lngCol)) Then X(lngRow, lngCol) = vbNullString
If X(lngRow, lngCol) = 0 Then X(lngRow, lngCol) = vbNullString
If Len(X(lngRow, lngCol)) = 0 Then X(lngRow, lngCol) = vbNullString
Next
Next
rng1.Value2 = X
End Sub

Excel VBA Appending data to single Array

Am trying to parse an excel file using Excel VBA.
Here is the sample sata
I did some research and found you can assign ranges to array like
Arrayname = Range("A1:D200")
But am looking for some thing more dynamic, like add the below multiple ranges to a single array.
and my final array will be a single array/table with n is number of rows from all ranges and 4 columns.
Can any one please prvide me a example.
Thank you in adavance.
I think you are asking for more information about moving data between ranges and variables so that is the question I will attempt to answer.
Create a new workbook. Leave Sheet1 empty; set cell B3 of Sheet2 to "abc" and set cells C4 to F6 of Sheet3 to ="R"&ROW()&"C"&COLUMN()
Open the VB Editor, create a module and copy the follow code to it. Run macro Demo01().
Option Explicit
Sub Demo01()
Dim ColURV As Long
Dim InxWkSht As Long
Dim RowURV As Long
Dim UsedRangeValue As Variant
' For each worksheet in the workbook
For InxWkSht = 1 To Worksheets.Count
With Worksheets(InxWkSht)
Debug.Print .Name
If .UsedRange Is Nothing Then
Debug.Print " Empty sheet"
Else
Debug.Print " Row range: " & .UsedRange.Row & " to " & _
.UsedRange.Row + .UsedRange.Rows.Count - 1
Debug.Print " Col range: " & .UsedRange.Column & " to " & _
.UsedRange.Column + .UsedRange.Columns.Count - 1
End If
UsedRangeValue = .UsedRange.Value
If IsEmpty(UsedRangeValue) Then
Debug.Print " Empty sheet"
ElseIf VarType(UsedRangeValue) > vbArray Then
' More than one cell used
Debug.Print " Values:"
For RowURV = 1 To UBound(UsedRangeValue, 1)
Debug.Print " ";
For ColURV = 1 To UBound(UsedRangeValue, 2)
Debug.Print " " & UsedRangeValue(RowURV, ColURV);
Next
Debug.Print
Next
Else
' Must be single cell worksheet
Debug.Print " Value = " & UsedRangeValue
End If
End With
Next
End Sub
The following will appear in the Immediate Window:
Sheet1
Row range: 1 to 1
Col range: 1 to 1
Empty sheet
Sheet2
Row range: 3 to 3
Col range: 2 to 2
Value = abc
Sheet3
Row range: 4 to 6
Col range: 3 to 5
Values:
R4C3 R4C4 R4C5
R5C3 R5C4 R5C5
R6C3 R6C4 R6C5
If you work through the macro and study the output you will get an introduction to loading a range to a variant. The points I particularly want you to note are:
The variable to which the range is loaded is of type Variant. I have never tried loading a single range to a Variant array since the result may not be an array. Even if it works, I would find this confusing.
Sheet1 is empty but the used range tells you than cell A1 is used. However, the variant to which I have loaded the sheet is empty.
The variant only becomes an array if the range contains more than one cell. Note: the array will ALWAYS be two dimensional even if the range is a single row or a single column.
The lower bounds of the array are ALWAYS 1.
The column and row dimensions are not standard with the rows as dimension 1 and the columns as dimension 2.
If there is any doubt about the nature of the range being loaded, you must use IsEmpty and VarType to test its nature.
You may also like to look at: https://stackoverflow.com/a/16607070/973283. Skim the explanations of macros Demo01() and Demo02() which are not relevant to you but set the context. Macro Demo03() shows the advanced technique of loading multiple worksheets to a jagged array.
Now create a new worksheet and leave it with the default name of Sheet4.
Add the follow code to the module. Run macro Demo02().
Sub Demo02()
Dim ColOut As Long
Dim OutputValue() As String
Dim Rng As Range
Dim RowOut As Long
Dim Stg As String
ReDim OutputValue(5 To 10, 3 To 6)
For RowOut = LBound(OutputValue, 1) To UBound(OutputValue, 1)
For ColOut = LBound(OutputValue, 2) To UBound(OutputValue, 2)
OutputValue(RowOut, ColOut) = RowOut + ColOut
Next
Next
With Worksheets("Sheet4")
Set Rng = .Range("A1:D6")
End With
Rng.Value = OutputValue
With Worksheets("Sheet4")
Set Rng = .Range(.Cells(8, 2), .Cells(12, 4))
End With
Rng.Value = OutputValue
With Worksheets("Sheet4")
Stg = "C" & 14 & ":G" & 20
Set Rng = .Range(Stg)
End With
Rng.Value = OutputValue
End Sub
Although this macro writes an array to a worksheet, many of the points apply for the opposite direction. The points I particularly want you to note are:
For output, the array does not have to be Variant nor do the lower bounds have to be 1. I have made OutputValue a String array so the values output are strings. Change OutputValue to a Variant array and rerun the macro to see the effect.
I have used three different ways of creating the range to demonstrate some of your choices.
If you specify a range as I have, the worksheet is one of the properties of the range. That is why I can take Rng.Value = OutputValue outside the With ... End With and still have the data written to the correct worksheet.
When copying from a range to a variant, Excel sets the dimensions of the variant as appropriate. When copying from an array to a range, it is your responsibility to get the size of the range correct. With the second range, I lost data. With the third range, I gained N/As.
I hope the above gives you an idea of your options. If I understand your requirement correctly, you will have to:
Load the entire worksheet to Variant
Create a new Array of the appropriate size
Selectively copy data from the Variant to the Array.
Come back withh questions if anything is unclear.

Excel Macro for Selected Area Concatenation

I was hoping someone would have some insight as to how to approach the following Excel macro requirement.
Starting condition:
Variable number of text values in Column A.
Proposed solution:
I would like to be able to select a variable number of consecutive cells in column A, and then have the text concatenated, separated by a comma and , into a single column adjacent to the top most cell in column B.
Examples:
A2-A4 would be selected on the sheet.
After running the macro, the contents of B2 (Directly adjacent to top of selection) would contain text in the form "A2, A3, A4".
A5-A10 selected:
After running the macro, the contents of B5 (Directly adjacent to top of selection) would contain text in the form "A5, A6, A7, A8, A9, A10".
What is killing me is how to utilize the variablity of multiple selections and additonally, I'm not clear on how to handle looping in Excel macro's. I have a CS degree but I ended up working in Infrastructure so I'm a bit rusty. Is someone could help, this would save me emmense time everyday. Thanks to any responses.
The following code does what you seek. I have not added many comments because I am not sure what level of comments are appropriate. For example, I do not want to explain the purpose of each statement if your CS degree allows you to guess. I also suspect there is more to your question than the obvious. For example, should I have made this a function with the worksheet and row numbers passed as parameters. Please come back with questions and I will improve my answer as necessary.
Option Explicit
Sub JoinCells()
Dim ColFirst As Long
Dim ColLast As Long
Dim JoinedValue As String
Dim RowCrnt As Long
Dim RowFirst As Long
Dim RowLast As Long
RowFirst = Selection.Row ' First row of selection
' Selection.Rows.Count returns the number of rows in the selection.
' Warning! You can fool this code by making multiple selections.
RowLast = RowFirst + Selection.Rows.Count - 1
ColFirst = Selection.Column
ColLast = ColFirst + Selection.Columns.Count - 1
If ColFirst <> 1 Or ColLast <> 1 Then
Call MsgBox("Please select a range within column ""A""", vbOKOnly)
Exit Sub
End If
With Worksheets("xxxxxxx") ' Worksheet of your choice.
JoinedValue = .Cells(RowFirst, "A").Value
For RowCrnt = RowFirst + 1 To RowLast
JoinedValue = JoinedValue & "," & .Cells(RowCrnt, "A").Value
Next
.Cells(RowFirst, "B").Value = JoinedValue
End With
End Sub

Macro to move number with dash to new cell

In Excel, I am trying to get a macro to move numbers with a "-".
I have a column E with a list of numbers
54525841-1
454152
1365466
1254566-1
1452577-1
I want a macro to move all the numbers that have a dash or hyphen at the end to column C.
So I would need E1 54525841-1 to be moved to C1.
You'll need to change "Sheet1" to the name of the sheet where your data is.
This looks through every cell (with data) in the E column and moves the value accross to the C column if it contains a dash.
Sub MoveDashes()
Dim Sheet As Worksheet
Dim Index As Long
Set Sheet = ThisWorkbook.Worksheets("Sheet1")
For Index = 1 To Sheet.Cells(Application.Rows.Count, "E").End(xlUp).Row
If InStr(1, Sheet.Cells(Index, "E"), "-") > 0 Then
Sheet.Cells(Index, "C") = Sheet.Cells(Index, "E").Value
Sheet.Cells(Index, "E").Value = ""
End If
Next
End Sub
Does it have to be a macro? How about Advanced Filter?
Your numbers are in column E. Let's assume they have a header.
E1: Number
E2: 54525841-1
E3: 454152
E4: 1365466
E5: 1254566-1
E6: 1452577-1
In a separate area of your worksheet (let's say column G) put the following criteria:
G1: Number
G2: *-*
Your advanced filter criteria would look like this:
Anything with a "-" in it will be copied to column C.
I got it to work by this:
Sub MoveDash()
x = Range("E" & Rows.Count).End(xlUp).Row
For Each Cell In Range("E2:E" & x)
If InStr(Cell, "-") <> 0 Then
Cell.Offset(, 1) = Cell
Cell.ClearContents
End If
Next Cell
end sub
You can do this without VBA, but here is an efficient way to do it using the dictionary object.
Sub MoveNumbersWithDash()
Application.ScreenUpdating = False
Dim i As Long, lastRow As Long
Dim varray As Variant
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
lastRow = Range("E" & Rows.Count).End(xlUp).Row
varray = Range("E1:E" & lastRow).Value
For i = 1 To UBound(varray, 1)
If InStr(1, varray(i, 1), "-") <> 0 Then
dict.Add i, varray(i, 1)
End If
Next
Range("C1").Resize(dict.Count).Value = _
Application.WorksheetFunction.Transpose(dict.items)
Application.ScreenUpdating = True
End Sub
How it works:
The major theme here is avoiding calls to Excel (like a for each loop). This will make the function blazing fast (especially if you have tens and thousands of rows) and more efficient. First I locate the last cell used in E then dump the entire row into a variant array in one move. Then I loop through each element, checking if it contains a "-", if it does, I add it to a dictionary object. POINT: Add the entry as the ITEM, not KEY. This makes sure that we allow for duplicates. The variable I will be unique for each entry, so I use that as the key. Then I simple dump the entire array of cells with "-" into column C.
Why Dictionary?
The dictionary object is very fast and comes with 2 really great functions: .Keys and .Items. These will return an array of all the keys or items in the dictionary, which you can use the Transpose function on to dump an entire column of values into Excel in one step. Super efficient.

Resources