Excel-VBA Solutions

Split a Long Row of Data Into Multiple Rows

We can use Excel Macros to organize our data. Below is one such example. Here what we going to do is split long row of data into multiple rows. Here the rule is we need 5 cells per row, then to start the next row. So data in F1 will move to A2, G1 to B2 and so on. Same on third row until data runs out.

Here is how our data currently in the sheet.

Below is the end result we need.

So here is the sample code to do that. You can customize the code to suit to your situation. New sheet will be added and result will be created in that sheet. At last sheet will renamed as "Result sheet" and activated. And you will get a confirmation message at end.

Dim WS As Worksheet
Dim WS_Result As Worksheet

Set WS = Worksheets("Input file")
Set WS_Result = Worksheets.Add

'find last column
Lastcol = WS.Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column

Counter = 1
ResultRowCount = 1
For i = 1 To Lastcol
If Counter = 6 Then
Counter = 1
ResultRowCount = ResultRowCount + 1
Else
WS_Result.Cells(ResultRowCount, Counter).Value = WS.Cells(1, i)
End If

WS_Result.Cells(ResultRowCount, Counter).Value = WS.Cells(1, i)

Counter = Counter + 1
Next i

WS_Result.Name = "Result sheet"
WS_Result.Activate
MsgBox "Completed!", vbInformation, ""

Detect Operating System

Sometimes we need to develop VBA programs to compatible with both Windows and Mac operating systems. If you develop a VBA code for windows, sometimes it will work for Mac as well. For an example if your program only manipulate data within a excel sheet it will work for both operating systems. But you will find that some VBA programs not compatible with Mac. For an example if you are trying to access a directory using a VBA code this will not work in both OS's. Because file path of Windows contains backslash ( \ ). But Mac use colon (:) to separate the folder names. This is an only one example. If you develop VBA programs you will find that there are various instances not supported by both OS's

So if your code is not compatible with both OS's, you will need to develop two VBA codes. But there are situations you don't know what OS your user will use. However you can make your code compatible with both OS by combining both codes. What you can do is first check the OS, and if it detects Mac, you can ask the program to follow one path by using a if statement. Else you can ask it to follow the path written for Windows.

Here is a VBA code to do that.

'If the operating system is Mac
If Application.OperatingSystem Like "*Mac*" Then
'..........
'Here goes the code compatible with Mac
'..........

'If windows
Else
'..........
'Here goes the code compatible with Windows
'..........
End If

Use of On Error GoTo 0

In this post I will explain why we need to use On Error GoTo 0 in error handling. I will explain the use of On Error GoTo 0 using a simple example.

Assume we need to make changes in different workbook. So first we need to declare the variable and set the workbook as follows.

Dim WB_Example As Workbook

Set WB_Example = Workbooks("Example File.xlsx")

So if we run above two lines variable WB_Example will be declared and workbook "Example File.xlsx" will be assigned to that variable. But this will be successful only if "Example File.xlsx" is in open state. Otherwise it will give below error.

If you click the debug button second line will be highlighted as follows

However if this workbook is not in open state, we can open it automatically and continue the rest of the code. For that we need to avoid that error message. Error message can be avoided and resume code using On Error Resume Next statement. We can do it as follows.

Dim WB_Example As Workbook

On Error Resume Next
Set WB_Example = Workbooks("Example File.xlsx")

If Err <> 0 Then
If Err.Number = 9 Then
Workbooks.Open ("D:\VBA Blog\On Error Goto Zero\Example File.xlsx")
Else
MsgBox "Unknown Error.", vbCritical, "warning!"
Exit Sub
End If
End If

So if there is an error, program will check whether error number is equal to 9. If it equals to 9, Then program will automatically opens the workbook. Because we know that this error occurs at this point due to workbook is not in open state. But if the error number is different to 9, error occurred due to some other reason. So program will notify it to the user and terminated at that point.

Think we run above code and didn't get any other Err.Number different to 9. So then our program will continue from above code. So this is where we need On Error GoTo 0. Consider the following code. If you look at the last line you will see that we are trying to put a string to a cell A1 of sheet2. But what will happen if we don't have worksheet with name "Sheet2". Progrma should give us an error.

But if you run the code, you will realized that it is not giving such error if there is no Sheet2 available. So this happen due to effect of On Error Resume Next statement. So this On Error Resume Next statement was helpful up to particular point of code. But after that we are getting unexpected problem due to it. So now we need to end effect of On Error Resume Next statement in a earliest possible point of our code. This can be done by using On Error GoTo 0 statement.

So now if we run the macro again and if there is no Sheet2 in our workbook, then we will get this error message.

So if you click the Debug button, last line will highlighted as follows.

So you can see that effect of On Error Resume Next statement is avoided by On Error GoTo 0.

Transposing an Array in VBA

In this post I will explain you a quick way to transpose an array. Sometimes we need to transpose our arrays before put it to worksheet. You can easily use below method for those situations.

So let's consider the below sample data for this example.

I have this data in Sheet10 of my Excel workbook.
So let's declare our variables and set the worksheet first.

Dim WS As Worksheet

Set WS = Worksheets("Sheet10")

Dim All_Data() As Variant

Now we can put above data to declared array.

All_Data = WS.Range("A1", "J4")

So we have put all the data to All_Data array.
Next we need to add new worksheet to put our transposed array.

Worksheets.Add

Then you can transpose the array and put it to new worksheet as follows.

ActiveSheet.Range("A1", Range("A1").Offset(UBound(All_Data, 2) - 1, 3)).Value = Application.Transpose(All_Data)

So below is the full code to transpose an array.

Dim WS As Worksheet

Set WS = Worksheets("Sheet10")

Dim All_Data() As Variant

All_Data = WS.Range("A1", "J4")

Worksheets.Add

ActiveSheet.Range("A1", Range("A1").Offset(UBound(All_Data, 2) - 1, 3)).Value = Application.Transpose(All_Data)

And you will get below result after running the macro.

Re-size Dynamic Arrays

Sometimes when we create dynamic arrays, we know how many elements our array will have. If we know that we can specify the upper bounds of the arrays in the Redim statement. But there are times we can't tell exactly how many elements our array will have. Because we might need to add new elements to our array when go through the subroutine. I will explain this using below example.

Consider this sample data.

Think we need to add records of each person to an array if that person get more than $7000 of monthly income. So we don't know how many people will be added to our array when we defining it.
Because items will be added to the array when go through the subroutine. So inside a for each loop, it will check the monthly income of each person and if it is more than $7000, records of that person will be added to the array. So below is the full code to do that.

Dim WS As Worksheet
Dim Rng As Range
Dim PeopleWithHigherIncome() As Variant
Dim HigherIncomeCounter As Long
Dim LoopCounter As Integer

Set WS = Worksheets("Sheet1")

'find last row
Lastrow = WS.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

HigherIncomeCounter = 0

For Each Rng In WS.Range("A2", "A" & Lastrow)

If Rng.Offset(0, 3).Value > 7000 Then

HigherIncomeCounter = HigherIncomeCounter + 1

ReDim Preserve PeopleWithHigherIncome(1 To 4, 1 To HigherIncomeCounter)

For LoopCounter = 1 To 4
PeopleWithHigherIncome(LoopCounter, HigherIncomeCounter) = Rng.Offset(0, LoopCounter - 1).Value
Next LoopCounter

End If

Next Rng

'Put PeopleWithHigherIncome array to new worksheet
Worksheets.Add

ActiveSheet.Range("A1", Range("A1").Offset(3, UBound(PeopleWithHigherIncome, 2) - 1)).Value = PeopleWithHigherIncome

Last two lines of above code will add new sheet and display the result array in that new worksheet.

Here is the final result you will get.

As you can see the values are transposed from our original data. In a next post I will explain how to transpose an array. So we can transpose this result array before put it to a worksheet.

Also there are few things you need to remember.

You can't use below line instead of ReDim Preserve PeopleWithHigherIncome(1 To 4, 1 To HigherIncomeCounter)

ReDim PeopleWithHigherIncome(1 To 4, 1 To HigherIncomeCounter)

Because if you use only ReDim keyword, it will delete earlier added items to the array. But ReDim Preserve keyword will add new items to the array without deleting existing items.

Also you can't write

ReDim Preserve PeopleWithHigherIncome(1 To HigherIncomeCounter, 1 To 4)

Instead of

ReDim Preserve PeopleWithHigherIncome(1 To 4, 1 To HigherIncomeCounter)

If you add Preserve keyword, it can only Re-dimension the last dimension of the array.

Calculate With Arrays

Sometimes we need to do calculations based on the data in our excel sheets and put the results back to the sheets. We can do these calculations for each cell one by one using a for next loop. But it can be inefficient in the running stage of the program. It won't be an issue if we only deal with sheets only have data in few rows. But in real world, we have to deal with sheets which have thousands of rows of data.

So in this post I will explain you how to calculate efficiently using arrays.

Here is the example we have.

It is a sample data set of employees of a company. Column D has their monthly income and column E has the tax rate. According to the above data, tax rate equals to 10%. Normally tax rate increases with the salary level. But to make this example simple, I have set it to 10% for any salary level. So now what we need to do is calculate Annual income, Tax and Remaining.

So let's start the coding.

First we need to declare variables.

Dim WS As Worksheet

Dim MonthlyIncome() As Variant
Dim Answers() As Variant

Dim D1 As Long
Dim i As Long

We are going use two variant type arrays for this example. Next we need to set the worksheet to declared variable.

Set WS = Worksheets("Sheet1")

Below line will add existing data to MonthlyIncome array.

MonthlyIncome = WS.Range("D2:D19")

We are going to store calculated results in a different array call Answers. For that, we need to determine it's dimensions. Following line will assign it's first dimension to the variable D1.

D1 = UBound(MonthlyIncome, 1)

As we need to store three different result for each employee, second dimension should equal to 3. So we can Redim the Answers array as follows.

ReDim Answers(1 To D1, 1 To 3)

Then below, for next loop will calculate the results for each employee and store the results in Answers array.

For i = 1 To D1
Answers(i, 1) = MonthlyIncome(i, 1) * 12
Answers(i, 2) = (MonthlyIncome(i, 1) * 12 * 10) / 100
Answers(i, 3) = Answers(i, 1) - Answers(i, 2)
Next i

Then we can write Answers array to worksheet.

WS.Range(Range("F2"), Range("F2").Offset(D1 - 1, 2)).Value = Answers

Finally it is good practice to erase the arrays

Erase MonthlyIncome
Erase Answers

So that is the step by step explanation about how to use arrays for calculations. Below is the full code for above example.

Dim WS As Worksheet

Dim MonthlyIncome() As Variant
Dim Answers() As Variant

Dim D1 As Long
Dim i As Long

Set WS = Worksheets("Sheet1")

MonthlyIncome = WS.Range("D2:D19")

D1 = UBound(MonthlyIncome, 1)

ReDim Answers(1 To D1, 1 To 3)

For i = 1 To D1
Answers(i, 1) = MonthlyIncome(i, 1) * 12
Answers(i, 2) = (MonthlyIncome(i, 1) * 12 * 10) / 100
Answers(i, 3) = Answers(i, 1) - Answers(i, 2)
Next i

WS.Range(Range("F2"), Range("F2").Offset(D1 - 1, 2)).Value = Answers

Erase MonthlyIncome
Erase Answers

Following is the result you will get after running the code.

Quickly Write Multidimensional Array to Excel Range

I explained how to write multidimensional array to an Excel range using for next loop from earlier post. But there is much quicker way to do that without for loop.

So lets put below data to a multidimensional array call "PopulationDensity" and then write it back to a new sheet using this quick method.

So here is the code to do that.

Dim WS As Worksheet

Set WS = Worksheets("Sheet4")

Dim PopulationDensity() As Variant

PopulationDensity = WS.Range("A2:D16")

Dim WS_New As Worksheet

Set WS_New = Worksheets.Add

WS_New.Range(Range("A1"), Range("A1").Offset(UBound(PopulationDensity, 1) - 1, _
UBound(PopulationDensity, 2) - 1)).Value = PopulationDensity

Erase PopulationDensity

And this is the result you will get.

Index of this array starts from 1. If index of your array start from 0 then you need to change below line

WS_New.Range(Range("A1"), Range("A1").Offset(UBound(PopulationDensity, 1) - 1, _
UBound(PopulationDensity, 2) - 1)).Value = PopulationDensity

as follows

WS_New.Range(Range("A1"), Range("A1").Offset(UBound(PopulationDensity, 1) , _
UBound(PopulationDensity, 2) )).Value = PopulationDensity