Posts tagged excel

Range Concatenation with a character

Jun29
2007 Leave a Comment Written by admin

Are you frustrated that you have to concatenate a range, and you have to do that using CONCATENATE formula by entering each cell and typing a comma after every cell? Well, here’s a solution to it. A procedure or a function whatever you like. If you use the procedure, it allows you to choose the input range, concatenate character, and the output range. If you use the function, then you can enter the optional concatenate character (by default it is a comma (,)), and the input range.

Here are both:

Procedure:

Public Sub ConCatwChar()
Dim sChar2bAdded As String, rngRng2bCated As Range, sOutput As String, rngTarget As Range, c As Range
On Error GoTo ConCatwChar_Error
‘You could use this line to return the concatenated string in this cell
‘Set rngTarget = ActiveCell

Set rngRng2bCated = Application.InputBox(prompt:=”Select the range you’d like to concatenate with a charcter”, _
Title:=”Select Range”, Type:=8)

If rngRng2bCated Is Nothing Then Exit Sub

‘You could use this line to set the default to a comma and remove the inputbox line
‘sChar2bAdded = “,”
sChar2bAdded = InputBox(“Enter the character you’d like to add between other cells”, “Enter Character”, “,”)

Set rngTarget = Application.InputBox(prompt:=”Select the range you’d like the output”, _
Title:=”Select Range”, Type:=8)

For Each c In rngRng2bCated
sOutput = sOutput & c.Value & sChar2bAdded
Next c

sOutput = Left(sOutput, Len(sOutput) – Len(sChar2bAdded))
rngTarget = sOutput

On Error GoTo 0
Exit Sub

ConCatwChar_Error:
MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in procedure ConCatwChar”
End Sub

Here’s the function:

‘You can change the option string character to nothing “” so that you get concatenated string without a character in between
Public Function ConCatFunc(rngRng2bCated As Range, Optional sChar2bAdded As String = “,”) As String
Dim sOutput As String, c As Range

On Error GoTo ConCatFunc_Error

For Each c In rngRng2bCated
sOutput = sOutput & c.Value & sChar2bAdded
Next c
sOutput = Left(sOutput, Len(sOutput) – Len(sChar2bAdded))
ConCatFunc = sOutput

On Error GoTo 0
Exit Function

ConCatFunc_Error:
ConCatFunc = “#Error#”

End Function

Posted in String Operations, Useful Procedures - Tagged ,

Trendline coefficients and regression analysis

Jan30
2006 Leave a Comment Written by admin

Tushar has a great tutorial on his website. It tells you a lot about regression, trendline and using them in VBA. Check it out!

Trendline coefficients: “Trendline Coefficients and Regression Analysis”

Posted in Uncategorized, Useful Procedures - Tagged

Stack Columns of Data on one column

Dec23
2005 19 Comments Written by admin

I have modified this code for better explanation and error handling (includes a function to check if a worksheet exists or not). To run this code follow these steps:
1. Insert a new module in your workbook,
2. Copy and paste this code,
3. Go back to worksheet with data in it,
4. Press Alt + F8 to bring the macro window
5. Select this procedure and hit run
6. Enter the new worksheet name in the input box
7. If everything went well, you should have a new worksheet with all the data from original worksheet in one column with the column headers. See the screen shots for example.
Before stacking-the original data:
Before Stack
After stacking:
After Stack
Here’s the code:

Option Explicit
 
Sub Stack_cols()
 
On Error GoTo Stack_cols_Error
 
Dim lNoofRows As Long, lNoofCols As Long
Dim lLoopCounter As Long, lCountRows As Long
Dim sNewShtName As String
Dim shtOrg As Worksheet, shtNew As Worksheet
 
'Turn off the screen update to make macro run faster
Application.ScreenUpdating = False
'Ask for a new sheet name, if not provided use newsht
sNewShtName = InputBox("Enter the new worksheet name", "Enter name", "newsht")
'Set a sheet variable for the sheet where the data resides
Set shtOrg = ActiveSheet
'Add a new worksheet, rename it and set it to a variable
If Not SheetExists(sNewShtName) Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sNewShtName
Set shtNew = Worksheets(sNewShtName)
Else
MsgBox "Worksheet name exists. Try again", vbInformation, "Sheet Exists"
Exit Sub
End If
 
With shtOrg
'Get the last column number
'Replace .Range("IV1") with .Range("XFD1") for Excel 2007
lNoofCols = .Range("IV1").End(xlToLeft).Column
'Start a loop to copy and paste data from the first column to the last column
For lLoopCounter = 1 To lNoofCols
'Count the number of rows in the looping column
'Replace .Cells(65536, lLoopCounter) with .Cells(1048576, lLoopCounter) for Excel 2007
lNoofRows = .Cells(65536, lLoopCounter).End(xlUp).Row
.Range(.Cells(1, lLoopCounter), .Cells(lNoofRows, lLoopCounter)).Copy Destination:=shtNew.Range(shtNew.Cells(lCountRows + 1, 1), shtNew.Cells(lCountRows + lNoofRows, 1))
'count the number of rows in the new worksheet
lCountRows = lCountRows + lNoofRows
Next lLoopCounter
End With
 
On Error GoTo 0
SmoothExit_Stack_cols:
Application.ScreenUpdating = True
Exit Sub
 
Stack_cols_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub:Stack_cols"
Resume SmoothExit_Stack_cols
End Sub
'Check if a worksheet exists or not
Public Function SheetExists(sShtName As String) As Boolean
On Error Resume Next
 
Dim wsSheet As Worksheet, bResult As Boolean
bResult = False
Set wsSheet = Sheets(sShtName)
 
On Error GoTo 0
If Not wsSheet Is Nothing Then
bResult = True
End If
SheetExists = bResult
End Function
Posted in Useful Procedures - Tagged ,

Flip row or column

Mar30
2005 3 Comments Written by admin

To flip the given row as shown in this figure, use the following macro

Flip row or column

Result row

Flip row or column

You can use the same macro for flipping columns too, code will find if it’s a row or a column.

Note: This code was modified on 07/26/07 for error checking, and removal of Option Base

Sub flip()

Dim Arr As Variant
Dim myrange As Range
Dim vSplitedArr As Variant
Dim arRetArr() As Variant, lArrBnd As Long, i As Long

On Error GoTo flip_Error

Set myrange = Range(Selection.Address)
Arr = myrange ‘store the selected values in an array

‘split the selected cells address to an array
vSplitedArr = Split(Selection.Address, “$”)

‘ check if Column names are same
If vSplitedArr(1) = vSplitedArr(3) Then
lArrBnd = UBound(Arr, 1)
ReDim arRetArr(lArrBnd, 0)
For i = 0 To lArrBnd – 1
‘flip the array
arRetArr(i, 0) = Arr(lArrBnd – i, 1)
Next i
Range(Selection.Address) = arRetArr
‘check if Row numbers are same
ElseIf Replace(vSplitedArr(2), “:”, “”) = vSplitedArr(4) Then
lArrBnd = UBound(Arr, 2)
ReDim arRetArr(0, lArrBnd)
For i = 0 To lArrBnd – 1
‘flip the array
arRetArr(0, i) = Arr(1, lArrBnd – i)
Next i
Range(Selection.Address) = arRetArr
Else
MsgBox “Your selection contains multiple rows or columns.” & vbCrLf & _
“This macro will only work on either one column or one row”, vbCritical, “Flip Error”
End If

On Error GoTo 0
SmoothExit_flip:
Exit Sub

flip_Error:
MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in procedure flip”
Resume SmoothExit_flip
End Sub

Posted in Uncategorized - Tagged , ,

Save HTML files from one folder to Excel files in another folder

Mar10
2005 Leave a Comment Written by admin

This sub will open the specified file type from the specified directory and sace them as excel files. A file open dialog box will ask the user to select a file from the folder where the original files are kept. Then an output folder name will be asked and this folder should exist otherwise it would generate an error. Make the changes where commented and can be used for all other supported file types. Right now this sub will save the html files as excel files.

Public Sub saveas_XL()
Err.Clear
On Error GoTo errorhandler
Application.ScreenUpdating = False ‘won’t show changes in the application
ActiveSheet.Cells.Clear ‘clear all the contents on the sheet
Dim infile, fpath, cutnum, outputfolder, msg As String, HtmlFpath, n As Long, F
n = 0
‘change *.htm;*.html to the file type you want to save as an excel file
‘ a file open dialog box
infile = Application.GetOpenFilename(“Html Files(*.htm;*.html),*.htm;*.html”, , “Please select the HTML files folder”)
If infile = False Then
    Application.ScreenUpdating = True
    Exit Sub
End If
‘find path to the files
cutnum = InStrRev(infile, “\”)
fpath = Left(infile, cutnum)
HtmlFpath = fpath
‘change *.html to the file type
F = Dir(fpath & “*.html”) ‘will give the first file in that directory
Range(“A1″).Activate ‘cell A1 selected
Do While Len(F) > 0
    ActiveCell.Formula = F
    ActiveCell.Offset(1, 0).Select
    F = Dir() ‘second file
    n = n + 1
Loop
Sheet1.Range(Cells(1, 2), Cells(n, 2)) = Sheet1.Range(Cells(1, 1), Cells(n, 1)).Value
‘change .html to the extension type you want to save as an excel file
Sheet1.Range(Cells(1, 2), Cells(n, 2)).Replace What:=”.html”, Replacement:=”", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
‘will ask for the output folder where you want to save these files, this folder should exist
outputfolder = InputBox(“Enter the outputfolder name”, “Folder name”)
fpath = Left(fpath, Len(fpath) – 1)
cutnum = InStrRev(fpath, “\”)
fpath = Left(fpath, cutnum)
‘will open all the files in Column B and save as xl files
For i = 1 To n
    Workbooks.Open Filename:=HtmlFpath & Sheet1.Cells(i, 1)
    ActiveWorkbook.SaveAs Filename:=fpath & outputfolder & “\” & Sheet1.Cells(i, 2), FileFormat:=xlWorkbookNormal
    ActiveWorkbook.Close
Next i
Application.ScreenUpdating = True
MsgBox “Done”
Exit Sub
errorhandler:
msg = “Error # ” & Str(Err.Number) & ” was generated by ” _
            & Err.Source & Chr(13) & Err.Description & vbCrLf & vbCrLf & “Ending program now”
MsgBox msg, , “Error”, Err.HelpFile, Err.HelpContext
Application.ScreenUpdating = True
End Sub
Posted in Uncategorized - Tagged , ,
« Older Entries Newer Entries »